Columns now start at 1, as lines already did
[ghc-hetmet.git] / compiler / main / GHC.hs
index 707a81d..5289f71 100644 (file)
@@ -8,10 +8,17 @@
 
 module GHC (
        -- * Initialisation
 
 module GHC (
        -- * Initialisation
-       Session,
        defaultErrorHandler,
        defaultCleanupHandler,
        defaultErrorHandler,
        defaultCleanupHandler,
-       newSession,
+
+        -- * GHC Monad
+        Ghc, GhcT, GhcMonad(..),
+        runGhc, runGhcT, initGhcMonad,
+        gcatch, gbracket, gfinally,
+        clearWarnings, getWarnings, hasWarnings,
+        printExceptionAndWarnings, printWarnings,
+        handleSourceError, defaultCallbacks, GhcApiCallbacks(..),
+        needsTemplateHaskell,
 
        -- * Flags and settings
        DynFlags(..), DynFlag(..), Severity(..), HscTarget(..), dopt,
 
        -- * Flags and settings
        DynFlags(..), DynFlag(..), Severity(..), HscTarget(..), dopt,
@@ -19,7 +26,7 @@ module GHC (
        parseDynamicFlags,
        getSessionDynFlags,
        setSessionDynFlags,
        parseDynamicFlags,
        getSessionDynFlags,
        setSessionDynFlags,
-        parseStaticFlags,
+       parseStaticFlags,
 
        -- * Targets
        Target(..), TargetId(..), Phase,
 
        -- * Targets
        Target(..), TargetId(..), Phase,
@@ -30,21 +37,26 @@ module GHC (
        guessTarget,
        
         -- * Extending the program scope 
        guessTarget,
        
         -- * Extending the program scope 
-        extendGlobalRdrScope,  -- :: Session -> [GlobalRdrElt] -> IO ()
-        setGlobalRdrScope,     -- :: Session -> [GlobalRdrElt] -> IO ()
-        extendGlobalTypeScope, -- :: Session -> [Id] -> IO ()
-        setGlobalTypeScope,    -- :: Session -> [Id] -> IO ()
+        extendGlobalRdrScope,
+        setGlobalRdrScope,
+        extendGlobalTypeScope,
+        setGlobalTypeScope,
 
        -- * Loading\/compiling the program
        depanal,
 
        -- * Loading\/compiling the program
        depanal,
-       load, LoadHowMuch(..), SuccessFlag(..), -- also does depanal
+       load, loadWithLogger, LoadHowMuch(..),
+       SuccessFlag(..), succeeded, failed,
+        defaultWarnErrLogger, WarnErrLogger,
        workingDirectoryChanged,
        workingDirectoryChanged,
-       checkModule, CheckedModule(..),
-       TypecheckedSource, ParsedSource, RenamedSource,
-        compileToCore,
-
-       -- * Parsing Haddock comments
-       parseHaddockComment,
+        parseModule, typecheckModule, desugarModule, loadModule,
+        ParsedModule(..), TypecheckedModule(..), DesugaredModule(..),
+       TypecheckedSource, ParsedSource, RenamedSource,   -- ditto
+        TypecheckedMod, ParsedMod,
+        moduleInfo, renamedSource, typecheckedSource,
+        parsedSource, coreModule,
+        compileToCoreModule, compileToCoreSimplified,
+        compileCoreToObj,
+        getModSummary,
 
        -- * Inspecting the module structure of the program
        ModuleGraph, ModSummary(..), ms_mod_name, ModLocation(..),
 
        -- * Inspecting the module structure of the program
        ModuleGraph, ModSummary(..), ms_mod_name, ModLocation(..),
@@ -62,18 +74,24 @@ module GHC (
        modInfoIsExportedName,
        modInfoLookupName,
        lookupGlobalName,
        modInfoIsExportedName,
        modInfoLookupName,
        lookupGlobalName,
+       findGlobalAnns,
         mkPrintUnqualifiedForModule,
 
         mkPrintUnqualifiedForModule,
 
+        -- * Querying the environment
+        packageDbModules,
+
        -- * Printing
        PrintUnqualified, alwaysQualify,
 
        -- * Interactive evaluation
        getBindings, getPrintUnqual,
         findModule,
        -- * Printing
        PrintUnqualified, alwaysQualify,
 
        -- * Interactive evaluation
        getBindings, getPrintUnqual,
         findModule,
+        lookupModule,
 #ifdef GHCI
        setContext, getContext, 
        getNamesInScope,
        getRdrNamesInScope,
 #ifdef GHCI
        setContext, getContext, 
        getNamesInScope,
        getRdrNamesInScope,
+        getGRE,
        moduleIsInterpreted,
        getInfo,
        exprType,
        moduleIsInterpreted,
        getInfo,
        exprType,
@@ -92,9 +110,9 @@ module GHC (
         InteractiveEval.forward,
        showModule,
         isModuleInterpreted,
         InteractiveEval.forward,
        showModule,
         isModuleInterpreted,
-       compileExpr, HValue, dynCompileExpr,
+       InteractiveEval.compileExpr, HValue, dynCompileExpr,
        lookupName,
        lookupName,
-        GHC.obtainTerm, GHC.obtainTerm1, GHC.obtainTermB, reconstructType,
+        GHC.obtainTermFromId, GHC.obtainTermFromVal, reconstructType,
         modInfoModBreaks,
         ModBreaks(..), BreakIndex,
         BreakInfo(breakInfo_number, breakInfo_module),
         modInfoModBreaks,
         ModBreaks(..), BreakIndex,
         BreakInfo(breakInfo_number, breakInfo_module),
@@ -183,11 +201,30 @@ module GHC (
         srcSpanStartLine, srcSpanEndLine, 
         srcSpanStartCol, srcSpanEndCol,
 
         srcSpanStartLine, srcSpanEndLine, 
         srcSpanStartCol, srcSpanEndCol,
 
+        -- ** Located
+       Located(..),
+
+       -- *** Constructing Located
+       noLoc, mkGeneralLocated,
+
+       -- *** Deconstructing Located
+       getLoc, unLoc,
+
+       -- *** Combining and comparing Located values
+       eqLocated, cmpLocated, combineLocs, addCLoc,
+        leftmost_smallest, leftmost_largest, rightmost,
+        spans, isSubspanOf,
+
        -- * Exceptions
        GhcException(..), showGhcException,
 
        -- * Exceptions
        GhcException(..), showGhcException,
 
+        -- * Token stream manipulations
+        Token,
+        getTokenStream, getRichTokenStream,
+        showRichTokenStream, addSourceToTokens,
+
        -- * Miscellaneous
        -- * Miscellaneous
-       sessionHscEnv,
+       --sessionHscEnv,
        cyclicModuleErr,
   ) where
 
        cyclicModuleErr,
   ) where
 
@@ -205,72 +242,78 @@ import qualified Linker
 import Linker           ( HValue )
 import ByteCodeInstr
 import BreakArray
 import Linker           ( HValue )
 import ByteCodeInstr
 import BreakArray
-import NameSet
 import InteractiveEval
 import TcRnDriver
 #endif
 
 import TcIface
 import InteractiveEval
 import TcRnDriver
 #endif
 
 import TcIface
+import TcRnTypes        hiding (LIE)
 import TcRnMonad        ( initIfaceCheck )
 import Packages
 import NameSet
 import RdrName
 import TcRnMonad        ( initIfaceCheck )
 import Packages
 import NameSet
 import RdrName
-import HsSyn 
+import qualified HsSyn -- hack as we want to reexport the whole module
+import HsSyn hiding ((<.>))
 import Type             hiding (typeKind)
 import TcType           hiding (typeKind)
 import Id
 import Type             hiding (typeKind)
 import TcType           hiding (typeKind)
 import Id
-import Var              hiding (setIdType)
+import Var
 import TysPrim         ( alphaTyVars )
 import TyCon
 import Class
 import TysPrim         ( alphaTyVars )
 import TyCon
 import Class
-import FunDeps
+-- import FunDeps
 import DataCon
 import Name             hiding ( varName )
 import DataCon
 import Name             hiding ( varName )
-import OccName         ( parenSymOcc )
-import InstEnv         ( Instance, instanceDFunId, pprInstance, pprInstanceHdr )
+-- import OccName              ( parenSymOcc )
+import InstEnv         ( Instance, instanceDFunId, pprInstance, pprInstanceHdr,
+                          emptyInstEnv )
+import FamInstEnv       ( emptyFamInstEnv )
 import SrcLoc
 import SrcLoc
-import CoreSyn
+--import CoreSyn
+import TidyPgm
 import DriverPipeline
 import DriverPipeline
-import DriverPhases    ( HscSource(..), Phase(..), isHaskellSrcFilename, startPhase )
-import HeaderInfo      ( getImports, getOptions )
+import DriverPhases    ( Phase(..), isHaskellSrcFilename, startPhase )
+import HeaderInfo
 import Finder
 import Finder
-import HscMain          ( newHscEnv, hscFileCheck, HscChecked(..) )
+import HscMain
 import HscTypes
 import DynFlags
 import HscTypes
 import DynFlags
-import StaticFlags
+import StaticFlagParser
+import qualified StaticFlags
 import SysTools     ( initSysTools, cleanTempFiles, cleanTempFilesExcept,
                       cleanTempDirs )
 import SysTools     ( initSysTools, cleanTempFiles, cleanTempFilesExcept,
                       cleanTempDirs )
+import Annotations
 import Module
 import Module
-import UniqFM
-import UniqSet
-import Unique
-import PackageConfig
+import LazyUniqFM
+import qualified UniqFM as UFM
 import FiniteMap
 import Panic
 import Digraph
 import FiniteMap
 import Panic
 import Digraph
-import Bag             ( unitBag, listToBag )
-import ErrUtils                ( Severity(..), showPass, fatalErrorMsg, debugTraceMsg,
-                         mkPlainErrMsg, printBagOfErrors, printBagOfWarnings,
-                         WarnMsg )
-import qualified ErrUtils
+import Bag             ( unitBag, listToBag, emptyBag, isEmptyBag )
+import ErrUtils
+import MonadUtils
 import Util
 import Util
-import StringBuffer    ( StringBuffer, hGetStringBuffer )
+import StringBuffer    ( StringBuffer, hGetStringBuffer, nextChar )
 import Outputable
 import BasicTypes
 import Maybes          ( expectJust, mapCatMaybes )
 import Outputable
 import BasicTypes
 import Maybes          ( expectJust, mapCatMaybes )
-import HaddockParse
-import HaddockLex       ( tokenise )
+import FastString
+import Lexer
 
 import Control.Concurrent
 
 import Control.Concurrent
-import System.Directory ( getModificationTime, doesFileExist )
+import System.Directory ( getModificationTime, doesFileExist,
+                          getCurrentDirectory )
 import Data.Maybe
 import Data.List
 import qualified Data.List as List
 import Data.Maybe
 import Data.List
 import qualified Data.List as List
+import Data.Typeable    ( Typeable )
+import Data.Word        ( Word8 )
 import Control.Monad
 import System.Exit     ( exitWith, ExitCode(..) )
 import Control.Monad
 import System.Exit     ( exitWith, ExitCode(..) )
-import System.Time     ( ClockTime )
-import Control.Exception as Exception hiding (handle)
+import System.Time     ( ClockTime, getClockTime )
+import Exception
 import Data.IORef
 import Data.IORef
+import System.FilePath
 import System.IO
 import System.IO.Error ( try, isDoesNotExistError )
 import Prelude hiding (init)
 import System.IO
 import System.IO.Error ( try, isDoesNotExistError )
 import Prelude hiding (init)
@@ -283,81 +326,159 @@ import Prelude hiding (init)
 -- Unless you want to handle exceptions yourself, you should wrap this around
 -- the top level of your program.  The default handlers output the error
 -- message(s) to stderr and exit cleanly.
 -- Unless you want to handle exceptions yourself, you should wrap this around
 -- the top level of your program.  The default handlers output the error
 -- message(s) to stderr and exit cleanly.
-defaultErrorHandler :: DynFlags -> IO a -> IO a
-defaultErrorHandler dflags inner = 
+defaultErrorHandler :: (ExceptionMonad m, MonadIO m) => DynFlags -> m a -> m a
+defaultErrorHandler dflags inner =
   -- top-level exception handler: any unrecognised exception is a compiler bug.
   -- top-level exception handler: any unrecognised exception is a compiler bug.
-  handle (\exception -> do
-          hFlush stdout
-          case exception of
-               -- an IO exception probably isn't our fault, so don't panic
-               IOException _ ->
-                 fatalErrorMsg dflags (text (show exception))
-               AsyncException StackOverflow ->
-                 fatalErrorMsg dflags (text "stack overflow: use +RTS -K<size> to increase it")
-               _other ->
-                 fatalErrorMsg dflags (text (show (Panic (show exception))))
-          exitWith (ExitFailure 1)
+  ghandle (\exception -> liftIO $ do
+           hFlush stdout
+           case fromException exception of
+                -- an IO exception probably isn't our fault, so don't panic
+                Just (ioe :: IOException) ->
+                  fatalErrorMsg dflags (text (show ioe))
+                _ -> case fromException exception of
+                     Just StackOverflow ->
+                         fatalErrorMsg dflags (text "stack overflow: use +RTS -K<size> to increase it")
+                     _ -> case fromException exception of
+                          Just (ex :: ExitCode) -> throw ex
+                          _ ->
+                              fatalErrorMsg dflags
+                                  (text (show (Panic (show exception))))
+           exitWith (ExitFailure 1)
          ) $
 
          ) $
 
-  -- program errors: messages with locations attached.  Sometimes it is
-  -- convenient to just throw these as exceptions.
-  handleDyn (\dyn -> do printBagOfErrors dflags (unitBag dyn)
-                       exitWith (ExitFailure 1)) $
-
   -- error messages propagated as exceptions
   -- error messages propagated as exceptions
-  handleDyn (\dyn -> do
+  handleGhcException
+            (\ge -> liftIO $ do
                hFlush stdout
                hFlush stdout
-               case dyn of
+               case ge of
                     PhaseFailed _ code -> exitWith code
                     Interrupted -> exitWith (ExitFailure 1)
                     PhaseFailed _ code -> exitWith code
                     Interrupted -> exitWith (ExitFailure 1)
-                    _ -> do fatalErrorMsg dflags (text (show (dyn :: GhcException)))
+                    _ -> do fatalErrorMsg dflags (text (show ge))
                             exitWith (ExitFailure 1)
            ) $
   inner
 
                             exitWith (ExitFailure 1)
            ) $
   inner
 
--- | Install a default cleanup handler to remove temporary files
--- deposited by a GHC run.  This is seperate from
--- 'defaultErrorHandler', because you might want to override the error
--- handling, but still get the ordinary cleanup behaviour.
-defaultCleanupHandler :: DynFlags -> IO a -> IO a
-defaultCleanupHandler dflags inner = 
+-- | Install a default cleanup handler to remove temporary files deposited by
+-- a GHC run.  This is seperate from 'defaultErrorHandler', because you might
+-- want to override the error handling, but still get the ordinary cleanup
+-- behaviour.
+defaultCleanupHandler :: (ExceptionMonad m, MonadIO m) =>
+                         DynFlags -> m a -> m a
+defaultCleanupHandler dflags inner =
     -- make sure we clean up after ourselves
     -- make sure we clean up after ourselves
-    later (do cleanTempFiles dflags
+    inner `gfinally`
+          (liftIO $ do
+              cleanTempFiles dflags
               cleanTempDirs dflags
           )
               cleanTempDirs dflags
           )
-          -- exceptions will be blocked while we clean the temporary files,
+          --  exceptions will be blocked while we clean the temporary files,
           -- so there shouldn't be any difficulty if we receive further
           -- signals.
           -- so there shouldn't be any difficulty if we receive further
           -- signals.
-    inner
 
 
-
--- | Starts a new session.  A session consists of a set of loaded
--- modules, a set of options (DynFlags), and an interactive context.
-newSession :: Maybe FilePath -> IO Session
-newSession mb_top_dir = do
+-- | Print the error message and all warnings.  Useful inside exception
+--   handlers.  Clears warnings after printing.
+printExceptionAndWarnings :: GhcMonad m => SourceError -> m ()
+printExceptionAndWarnings err = do
+    let errs = srcErrorMessages err
+    warns <- getWarnings
+    dflags <- getSessionDynFlags
+    if isEmptyBag errs
+       -- Empty errors means we failed due to -Werror.  (Since this function
+       -- takes a source error as argument, we know for sure _some_ error
+       -- did indeed happen.)
+       then liftIO $ do
+              printBagOfWarnings dflags warns
+              printBagOfErrors dflags (unitBag warnIsErrorMsg)
+       else liftIO $ printBagOfErrors dflags errs
+    clearWarnings
+
+-- | Print all accumulated warnings using 'log_action'.
+printWarnings :: GhcMonad m => m ()
+printWarnings = do
+    dflags <- getSessionDynFlags
+    warns <- getWarnings
+    liftIO $ printBagOfWarnings dflags warns
+    clearWarnings
+
+-- | Run function for the 'Ghc' monad.
+--
+-- It initialises the GHC session and warnings via 'initGhcMonad'.  Each call
+-- to this function will create a new session which should not be shared among
+-- several threads.
+--
+-- Any errors not handled inside the 'Ghc' action are propagated as IO
+-- exceptions.
+
+runGhc :: Maybe FilePath  -- ^ See argument to 'initGhcMonad'.
+       -> Ghc a           -- ^ The action to perform.
+       -> IO a
+runGhc mb_top_dir ghc = do
+  wref <- newIORef emptyBag
+  ref <- newIORef undefined
+  let session = Session ref wref
+  flip unGhc session $ do
+    initGhcMonad mb_top_dir
+    ghc
+  -- XXX: unregister interrupt handlers here?
+
+-- | Run function for 'GhcT' monad transformer.
+--
+-- It initialises the GHC session and warnings via 'initGhcMonad'.  Each call
+-- to this function will create a new session which should not be shared among
+-- several threads.
+
+runGhcT :: (ExceptionMonad m, Functor m, MonadIO m) =>
+           Maybe FilePath  -- ^ See argument to 'initGhcMonad'.
+        -> GhcT m a        -- ^ The action to perform.
+        -> m a
+runGhcT mb_top_dir ghct = do
+  wref <- liftIO $ newIORef emptyBag
+  ref <- liftIO $ newIORef undefined
+  let session = Session ref wref
+  flip unGhcT session $ do
+    initGhcMonad mb_top_dir
+    ghct
+
+-- | Initialise a GHC session.
+--
+-- If you implement a custom 'GhcMonad' you must call this function in the
+-- monad run function.  It will initialise the session variable and clear all
+-- warnings.
+--
+-- The first argument should point to the directory where GHC's library files
+-- reside.  More precisely, this should be the output of @ghc --print-libdir@
+-- of the version of GHC the module using this API is compiled with.  For
+-- portability, you should use the @ghc-paths@ package, available at
+-- <http://hackage.haskell.org/cgi-bin/hackage-scripts/package/ghc-paths>.
+
+initGhcMonad :: GhcMonad m => Maybe FilePath -> m ()
+initGhcMonad mb_top_dir = do
   -- catch ^C
   -- catch ^C
-  main_thread <- myThreadId
-  modifyMVar_ interruptTargetThread (return . (main_thread :))
-  installSignalHandlers
-
-  initStaticOpts
-  dflags0 <- initSysTools mb_top_dir defaultDynFlags
-  dflags  <- initDynFlags dflags0
-  env <- newHscEnv dflags
-  ref <- newIORef env
-  return (Session ref)
-
--- tmp: this breaks the abstraction, but required because DriverMkDepend
--- needs to call the Finder.  ToDo: untangle this.
-sessionHscEnv :: Session -> IO HscEnv
-sessionHscEnv (Session ref) = readIORef ref
+  main_thread <- liftIO $ myThreadId
+  liftIO $ modifyMVar_ interruptTargetThread (return . (main_thread :))
+  liftIO $ installSignalHandlers
+
+  liftIO $ StaticFlags.initStaticOpts
+
+  dflags0 <- liftIO $ initDynFlags defaultDynFlags
+  dflags <- liftIO $ initSysTools mb_top_dir dflags0
+  env <- liftIO $ newHscEnv defaultCallbacks dflags
+  setSession env
+  clearWarnings
+
+defaultCallbacks :: GhcApiCallbacks
+defaultCallbacks =
+  GhcApiCallbacks {
+    reportModuleCompilationResult =
+        \_ mb_err -> defaultWarnErrLogger mb_err
+  }
 
 -- -----------------------------------------------------------------------------
 -- Flags & settings
 
 -- | Grabs the DynFlags from the Session
 
 -- -----------------------------------------------------------------------------
 -- Flags & settings
 
 -- | Grabs the DynFlags from the Session
-getSessionDynFlags :: Session -> IO DynFlags
-getSessionDynFlags s = withSession s (return . hsc_dflags)
+getSessionDynFlags :: GhcMonad m => m DynFlags
+getSessionDynFlags = withSession (return . hsc_dflags)
 
 -- | Updates the DynFlags in a Session.  This also reads
 -- the package database (unless it has already been read),
 
 -- | Updates the DynFlags in a Session.  This also reads
 -- the package database (unless it has already been read),
@@ -370,29 +491,37 @@ getSessionDynFlags s = withSession s (return . hsc_dflags)
 -- flags.  If you are not doing linking or doing static linking, you
 -- can ignore the list of packages returned.
 --
 -- flags.  If you are not doing linking or doing static linking, you
 -- can ignore the list of packages returned.
 --
-setSessionDynFlags :: Session -> DynFlags -> IO [PackageId]
-setSessionDynFlags (Session ref) dflags = do
-  hsc_env <- readIORef ref
-  (dflags', preload) <- initPackages dflags
-  writeIORef ref $! hsc_env{ hsc_dflags = dflags' }
+setSessionDynFlags :: GhcMonad m => DynFlags -> m [PackageId]
+setSessionDynFlags dflags = do
+  (dflags', preload) <- liftIO $ initPackages dflags
+  modifySession (\h -> h{ hsc_dflags = dflags' })
   return preload
 
 -- | If there is no -o option, guess the name of target executable
 -- by using top-level source file name as a base.
   return preload
 
 -- | If there is no -o option, guess the name of target executable
 -- by using top-level source file name as a base.
-guessOutputFile :: Session -> IO ()
-guessOutputFile s = modifySession s $ \env ->
+guessOutputFile :: GhcMonad m => m ()
+guessOutputFile = modifySession $ \env ->
     let dflags = hsc_dflags env
         mod_graph = hsc_mod_graph env
     let dflags = hsc_dflags env
         mod_graph = hsc_mod_graph env
-        mainModuleSrcPath, guessedName :: Maybe String
+        mainModuleSrcPath :: Maybe String
         mainModuleSrcPath = do
             let isMain = (== mainModIs dflags) . ms_mod
             [ms] <- return (filter isMain mod_graph)
             ml_hs_file (ms_location ms)
         mainModuleSrcPath = do
             let isMain = (== mainModIs dflags) . ms_mod
             [ms] <- return (filter isMain mod_graph)
             ml_hs_file (ms_location ms)
-        guessedName = fmap basenameOf mainModuleSrcPath
+        name = fmap dropExtension mainModuleSrcPath
+
+#if defined(mingw32_HOST_OS)
+        -- we must add the .exe extention unconditionally here, otherwise
+        -- when name has an extension of its own, the .exe extension will
+        -- not be added by DriverPipeline.exeFileName.  See #2248
+        name_exe = fmap (<.> "exe") name
+#else
+        name_exe = name
+#endif
     in
     case outputFile dflags of
         Just _ -> env
     in
     case outputFile dflags of
         Just _ -> env
-        Nothing -> env { hsc_dflags = dflags { outputFile = guessedName } }
+        Nothing -> env { hsc_dflags = dflags { outputFile = name_exe } }
 
 -- -----------------------------------------------------------------------------
 -- Targets
 
 -- -----------------------------------------------------------------------------
 -- Targets
@@ -403,157 +532,191 @@ guessOutputFile s = modifySession s $ \env ->
 -- | Sets the targets for this session.  Each target may be a module name
 -- or a filename.  The targets correspond to the set of root modules for
 -- the program\/library.  Unloading the current program is achieved by
 -- | Sets the targets for this session.  Each target may be a module name
 -- or a filename.  The targets correspond to the set of root modules for
 -- the program\/library.  Unloading the current program is achieved by
--- setting the current set of targets to be empty, followed by load.
-setTargets :: Session -> [Target] -> IO ()
-setTargets s targets = modifySession s (\h -> h{ hsc_targets = targets })
+-- setting the current set of targets to be empty, followed by 'load'.
+setTargets :: GhcMonad m => [Target] -> m ()
+setTargets targets = modifySession (\h -> h{ hsc_targets = targets })
 
 
--- | returns the current set of targets
-getTargets :: Session -> IO [Target]
-getTargets s = withSession s (return . hsc_targets)
+-- | Returns the current set of targets
+getTargets :: GhcMonad m => m [Target]
+getTargets = withSession (return . hsc_targets)
 
 
--- | Add another target
-addTarget :: Session -> Target -> IO ()
-addTarget s target
-  = modifySession s (\h -> h{ hsc_targets = target : hsc_targets h })
+-- | Add another target.
+addTarget :: GhcMonad m => Target -> m ()
+addTarget target
+  = modifySession (\h -> h{ hsc_targets = target : hsc_targets h })
 
 -- | Remove a target
 
 -- | Remove a target
-removeTarget :: Session -> TargetId -> IO ()
-removeTarget s target_id
-  = modifySession s (\h -> h{ hsc_targets = filter (hsc_targets h) })
+removeTarget :: GhcMonad m => TargetId -> m ()
+removeTarget target_id
+  = modifySession (\h -> h{ hsc_targets = filter (hsc_targets h) })
   where
   where
-   filter targets = [ t | t@(Target id _) <- targets, id /= target_id ]
+   filter targets = [ t | t@(Target id _ _) <- targets, id /= target_id ]
 
 
--- Attempts to guess what Target a string refers to.  This function implements
--- the --make/GHCi command-line syntax for filenames: 
+-- | Attempts to guess what Target a string refers to.  This function
+-- implements the @--make@/GHCi command-line syntax for filenames:
+--
+--   - if the string looks like a Haskell source filename, then interpret it
+--     as such
+--
+--   - if adding a .hs or .lhs suffix yields the name of an existing file,
+--     then use that
 --
 --
---     - if the string looks like a Haskell source filename, then interpret
---       it as such
---     - if adding a .hs or .lhs suffix yields the name of an existing file,
---       then use that
---     - otherwise interpret the string as a module name
+--   - otherwise interpret the string as a module name
 --
 --
-guessTarget :: String -> Maybe Phase -> IO Target
-guessTarget file (Just phase)
-   = return (Target (TargetFile file (Just phase)) Nothing)
-guessTarget file Nothing
+guessTarget :: GhcMonad m => String -> Maybe Phase -> m Target
+guessTarget str (Just phase)
+   = return (Target (TargetFile str (Just phase)) True Nothing)
+guessTarget str Nothing
    | isHaskellSrcFilename file
    | isHaskellSrcFilename file
-   = return (Target (TargetFile file Nothing) Nothing)
+   = return (target (TargetFile file Nothing))
    | otherwise
    | otherwise
-   = do exists <- doesFileExist hs_file
+   = do exists <- liftIO $ doesFileExist hs_file
        if exists
        if exists
-          then return (Target (TargetFile hs_file Nothing) Nothing)
+          then return (target (TargetFile hs_file Nothing))
           else do
           else do
-       exists <- doesFileExist lhs_file
+       exists <- liftIO $ doesFileExist lhs_file
        if exists
        if exists
-          then return (Target (TargetFile lhs_file Nothing) Nothing)
+          then return (target (TargetFile lhs_file Nothing))
           else do
           else do
-       return (Target (TargetModule (mkModuleName file)) Nothing)
+        if looksLikeModuleName file
+           then return (target (TargetModule (mkModuleName file)))
+           else do
+        throwGhcException
+                 (ProgramError (showSDoc $
+                 text "target" <+> quotes (text file) <+> 
+                 text "is not a module name or a source file"))
      where 
      where 
-        hs_file  = file `joinFileExt` "hs"
-        lhs_file = file `joinFileExt` "lhs"
+         (file,obj_allowed)
+                | '*':rest <- str = (rest, False)
+                | otherwise       = (str,  True)
+
+        hs_file  = file <.> "hs"
+        lhs_file = file <.> "lhs"
+
+         target tid = Target tid obj_allowed Nothing
 
 -- -----------------------------------------------------------------------------
 -- Extending the program scope
 
 
 -- -----------------------------------------------------------------------------
 -- Extending the program scope
 
-extendGlobalRdrScope :: Session -> [GlobalRdrElt] -> IO ()
-extendGlobalRdrScope session rdrElts
-    = modifySession session $ \hscEnv ->
+extendGlobalRdrScope :: GhcMonad m => [GlobalRdrElt] -> m ()
+extendGlobalRdrScope rdrElts
+    = modifySession $ \hscEnv ->
       let global_rdr = hsc_global_rdr_env hscEnv
       in hscEnv{ hsc_global_rdr_env = foldl extendGlobalRdrEnv global_rdr rdrElts }
 
       let global_rdr = hsc_global_rdr_env hscEnv
       in hscEnv{ hsc_global_rdr_env = foldl extendGlobalRdrEnv global_rdr rdrElts }
 
-setGlobalRdrScope :: Session -> [GlobalRdrElt] -> IO ()
-setGlobalRdrScope session rdrElts
-    = modifySession session $ \hscEnv ->
+setGlobalRdrScope :: GhcMonad m => [GlobalRdrElt] -> m ()
+setGlobalRdrScope rdrElts
+    = modifySession $ \hscEnv ->
       hscEnv{ hsc_global_rdr_env = foldl extendGlobalRdrEnv emptyGlobalRdrEnv rdrElts }
 
       hscEnv{ hsc_global_rdr_env = foldl extendGlobalRdrEnv emptyGlobalRdrEnv rdrElts }
 
-extendGlobalTypeScope :: Session -> [Id] -> IO ()
-extendGlobalTypeScope session ids
-    = modifySession session $ \hscEnv ->
+extendGlobalTypeScope :: GhcMonad m => [Id] -> m ()
+extendGlobalTypeScope ids
+    = modifySession $ \hscEnv ->
       let global_type = hsc_global_type_env hscEnv
       in hscEnv{ hsc_global_type_env = extendTypeEnvWithIds global_type ids }
 
       let global_type = hsc_global_type_env hscEnv
       in hscEnv{ hsc_global_type_env = extendTypeEnvWithIds global_type ids }
 
-setGlobalTypeScope :: Session -> [Id] -> IO ()
-setGlobalTypeScope session ids
-    = modifySession session $ \hscEnv ->
+setGlobalTypeScope :: GhcMonad m => [Id] -> m ()
+setGlobalTypeScope ids
+    = modifySession $ \hscEnv ->
       hscEnv{ hsc_global_type_env = extendTypeEnvWithIds emptyTypeEnv ids }
 
 -- -----------------------------------------------------------------------------
       hscEnv{ hsc_global_type_env = extendTypeEnvWithIds emptyTypeEnv ids }
 
 -- -----------------------------------------------------------------------------
--- Parsing Haddock comments
-
-parseHaddockComment :: String -> Either String (HsDoc RdrName)
-parseHaddockComment string = parseHaddockParagraphs (tokenise string)
-
--- -----------------------------------------------------------------------------
 -- Loading the program
 
 -- Loading the program
 
--- Perform a dependency analysis starting from the current targets
+-- | Perform a dependency analysis starting from the current targets
 -- and update the session with the new module graph.
 -- and update the session with the new module graph.
-depanal :: Session -> [ModuleName] -> Bool -> IO (Maybe ModuleGraph)
-depanal (Session ref) excluded_mods allow_dup_roots = do
-  hsc_env <- readIORef ref
+--
+-- Dependency analysis entails parsing the @import@ directives and may
+-- therefore require running certain preprocessors.
+--
+-- Note that each 'ModSummary' in the module graph caches its 'DynFlags'.
+-- These 'DynFlags' are determined by the /current/ session 'DynFlags' and the
+-- @OPTIONS@ and @LANGUAGE@ pragmas of the parsed module.  Thus if you want to
+-- changes to the 'DynFlags' to take effect you need to call this function
+-- again.
+--
+depanal :: GhcMonad m =>
+           [ModuleName]  -- ^ excluded modules
+        -> Bool          -- ^ allow duplicate roots
+        -> m ModuleGraph
+depanal excluded_mods allow_dup_roots = do
+  hsc_env <- getSession
   let
         dflags  = hsc_dflags hsc_env
         targets = hsc_targets hsc_env
         old_graph = hsc_mod_graph hsc_env
        
   let
         dflags  = hsc_dflags hsc_env
         targets = hsc_targets hsc_env
         old_graph = hsc_mod_graph hsc_env
        
-  showPass dflags "Chasing dependencies"
-  debugTraceMsg dflags 2 (hcat [
+  liftIO $ showPass dflags "Chasing dependencies"
+  liftIO $ debugTraceMsg dflags 2 (hcat [
             text "Chasing modules from: ",
             hcat (punctuate comma (map pprTarget targets))])
 
             text "Chasing modules from: ",
             hcat (punctuate comma (map pprTarget targets))])
 
-  r <- downsweep hsc_env old_graph excluded_mods allow_dup_roots
-  case r of
-    Just mod_graph -> writeIORef ref hsc_env{ hsc_mod_graph = mod_graph }
-    _ -> return ()
-  return r
-
-{-
--- | The result of load.
-data LoadResult
-  = LoadOk     Errors  -- ^ all specified targets were loaded successfully.
-  | LoadFailed  Errors -- ^ not all modules were loaded.
-
-type Errors = [String]
-
-data ErrMsg = ErrMsg { 
-       errMsgSeverity  :: Severity,  -- warning, error, etc.
-       errMsgSpans     :: [SrcSpan],
-       errMsgShortDoc  :: Doc,
-       errMsgExtraInfo :: Doc
-       }
--}
+  mod_graph <- downsweep hsc_env old_graph excluded_mods allow_dup_roots
+  modifySession $ \_ -> hsc_env { hsc_mod_graph = mod_graph }
+  return mod_graph
 
 
+-- | Describes which modules of the module graph need to be loaded.
 data LoadHowMuch
    = LoadAllTargets
 data LoadHowMuch
    = LoadAllTargets
+     -- ^ Load all targets and its dependencies.
    | LoadUpTo ModuleName
    | LoadUpTo ModuleName
+     -- ^ Load only the given module and its dependencies.
    | LoadDependenciesOf ModuleName
    | LoadDependenciesOf ModuleName
+     -- ^ Load only the dependencies of the given module, but not the module
+     -- itself.
+
+-- | Try to load the program.  See 'LoadHowMuch' for the different modes.
+--
+-- This function implements the core of GHC's @--make@ mode.  It preprocesses,
+-- compiles and loads the specified modules, avoiding re-compilation wherever
+-- possible.  Depending on the target (see 'DynFlags.hscTarget') compilating
+-- and loading may result in files being created on disk.
+--
+-- Calls the 'reportModuleCompilationResult' callback after each compiling
+-- each module, whether successful or not.
+--
+-- Throw a 'SourceError' if errors are encountered before the actual
+-- compilation starts (e.g., during dependency analysis).  All other errors
+-- are reported using the callback.
+--
+load :: GhcMonad m => LoadHowMuch -> m SuccessFlag
+load how_much = do
+   mod_graph <- depanal [] False
+   load2 how_much mod_graph
+
+-- | A function called to log warnings and errors.
+type WarnErrLogger = GhcMonad m => Maybe SourceError -> m ()
+
+defaultWarnErrLogger :: WarnErrLogger
+defaultWarnErrLogger Nothing = printWarnings
+defaultWarnErrLogger (Just e) = printExceptionAndWarnings e
 
 -- | Try to load the program.  If a Module is supplied, then just
 -- attempt to load up to this target.  If no Module is supplied,
 -- then try to load all targets.
 
 -- | Try to load the program.  If a Module is supplied, then just
 -- attempt to load up to this target.  If no Module is supplied,
 -- then try to load all targets.
-load :: Session -> LoadHowMuch -> IO SuccessFlag
-load s@(Session ref) how_much
-   = do 
-       -- Dependency analysis first.  Note that this fixes the module graph:
-       -- even if we don't get a fully successful upsweep, the full module
-       -- graph is still retained in the Session.  We can tell which modules
-       -- were successfully loaded by inspecting the Session's HPT.
-       mb_graph <- depanal s [] False
-       case mb_graph of
-          Just mod_graph -> catchingFailure $ load2 s how_much mod_graph
-          Nothing        -> return Failed
-    where catchingFailure f = f `Exception.catch` \e -> do
-              hsc_env <- readIORef ref
-              -- trac #1565 / test ghci021:
-              -- let bindings may explode if we try to use them after
-              -- failing to reload
-              writeIORef ref $! hsc_env{ hsc_IC = emptyInteractiveContext }
-              throw e
-
-load2 :: Session -> LoadHowMuch -> [ModSummary] -> IO SuccessFlag
-load2 s@(Session ref) how_much mod_graph = do
-        guessOutputFile s
-       hsc_env <- readIORef ref
+--
+-- The first argument is a function that is called after compiling each
+-- module to print wanrings and errors.
+--
+-- While compiling a module, all 'SourceError's are caught and passed to the
+-- logger, however, this function may still throw a 'SourceError' if
+-- dependency analysis failed (e.g., due to a parse error).
+--
+loadWithLogger :: GhcMonad m => WarnErrLogger -> LoadHowMuch -> m SuccessFlag
+loadWithLogger logger how_much = do
+    -- Dependency analysis first.  Note that this fixes the module graph:
+    -- even if we don't get a fully successful upsweep, the full module
+    -- graph is still retained in the Session.  We can tell which modules
+    -- were successfully loaded by inspecting the Session's HPT.
+    withLocalCallbacks (\cbs -> cbs { reportModuleCompilationResult =
+                                          \_ -> logger }) $
+      load how_much
+
+load2 :: GhcMonad m => LoadHowMuch -> [ModSummary]
+      -> m SuccessFlag
+load2 how_much mod_graph = do
+        guessOutputFile
+       hsc_env <- getSession
 
         let hpt1      = hsc_HPT hsc_env
         let dflags    = hsc_dflags hsc_env
 
         let hpt1      = hsc_HPT hsc_env
         let dflags    = hsc_dflags hsc_env
@@ -568,6 +731,21 @@ load2 s@(Session ref) how_much mod_graph = do
                                        not (ms_mod_name s `elem` all_home_mods)]
        ASSERT( null bad_boot_mods ) return ()
 
                                        not (ms_mod_name s `elem` all_home_mods)]
        ASSERT( null bad_boot_mods ) return ()
 
+        -- check that the module given in HowMuch actually exists, otherwise
+        -- topSortModuleGraph will bomb later.
+        let checkHowMuch (LoadUpTo m)           = checkMod m
+            checkHowMuch (LoadDependenciesOf m) = checkMod m
+            checkHowMuch _ = id
+
+            checkMod m and_then
+                | m `elem` all_home_mods = and_then
+                | otherwise = do 
+                        liftIO $ errorMsg dflags (text "no such module:" <+>
+                                         quotes (ppr m))
+                        return Failed
+
+        checkHowMuch how_much $ do
+
         -- mg2_with_srcimps drops the hi-boot nodes, returning a 
        -- graph with cycles.  Among other things, it is used for
         -- backing out partially complete cycles following a failed
         -- mg2_with_srcimps drops the hi-boot nodes, returning a 
        -- graph with cycles.  Among other things, it is used for
         -- backing out partially complete cycles following a failed
@@ -578,7 +756,7 @@ load2 s@(Session ref) how_much mod_graph = do
 
        -- If we can determine that any of the {-# SOURCE #-} imports
        -- are definitely unnecessary, then emit a warning.
 
        -- If we can determine that any of the {-# SOURCE #-} imports
        -- are definitely unnecessary, then emit a warning.
-       warnUnnecessarySourceImports dflags mg2_with_srcimps
+       warnUnnecessarySourceImports mg2_with_srcimps
 
        let
            -- check the stability property for each module.
 
        let
            -- check the stability property for each module.
@@ -591,9 +769,15 @@ load2 s@(Session ref) how_much mod_graph = do
                                (flattenSCCs mg2_with_srcimps)
                                stable_mods
 
                                (flattenSCCs mg2_with_srcimps)
                                stable_mods
 
-       evaluate pruned_hpt
+       _ <- liftIO $ evaluate pruned_hpt
+
+        -- before we unload anything, make sure we don't leave an old
+        -- interactive context around pointing to dead bindings.  Also,
+        -- write the pruned HPT to allow the old HPT to be GC'd.
+        modifySession $ \_ -> hsc_env{ hsc_IC = emptyInteractiveContext,
+                                       hsc_HPT = pruned_hpt }
 
 
-       debugTraceMsg dflags 2 (text "Stable obj:" <+> ppr stable_obj $$
+       liftIO $ debugTraceMsg dflags 2 (text "Stable obj:" <+> ppr stable_obj $$
                                text "Stable BCO:" <+> ppr stable_bco)
 
        -- Unload any modules which are going to be re-linked this time around.
                                text "Stable BCO:" <+> ppr stable_bco)
 
        -- Unload any modules which are going to be re-linked this time around.
@@ -601,7 +785,7 @@ load2 s@(Session ref) how_much mod_graph = do
                               | m <- stable_obj++stable_bco,
                                 Just hmi <- [lookupUFM pruned_hpt m],
                                 Just linkable <- [hm_linkable hmi] ]
                               | m <- stable_obj++stable_bco,
                                 Just hmi <- [lookupUFM pruned_hpt m],
                                 Just linkable <- [hm_linkable hmi] ]
-       unload hsc_env stable_linkables
+       liftIO $ unload hsc_env stable_linkables
 
         -- We could at this point detect cycles which aren't broken by
         -- a source-import, and complain immediately, but it seems better
 
         -- We could at this point detect cycles which aren't broken by
         -- a source-import, and complain immediately, but it seems better
@@ -654,11 +838,11 @@ load2 s@(Session ref) how_much mod_graph = do
        let cleanup = cleanTempFilesExcept dflags
                          (ppFilesFromSummaries (flattenSCCs mg2_with_srcimps))
 
        let cleanup = cleanTempFilesExcept dflags
                          (ppFilesFromSummaries (flattenSCCs mg2_with_srcimps))
 
-       debugTraceMsg dflags 2 (hang (text "Ready for upsweep") 
+       liftIO $ debugTraceMsg dflags 2 (hang (text "Ready for upsweep")
                                   2 (ppr mg))
         (upsweep_ok, hsc_env1, modsUpswept)
            <- upsweep (hsc_env { hsc_HPT = emptyHomePackageTable })
                                   2 (ppr mg))
         (upsweep_ok, hsc_env1, modsUpswept)
            <- upsweep (hsc_env { hsc_HPT = emptyHomePackageTable })
-                          pruned_hpt stable_mods cleanup mg
+                     pruned_hpt stable_mods cleanup mg
 
        -- Make modsDone be the summaries for each home module now
        -- available; this should equal the domain of hpt3.
 
        -- Make modsDone be the summaries for each home module now
        -- available; this should equal the domain of hpt3.
@@ -673,10 +857,10 @@ load2 s@(Session ref) how_much mod_graph = do
 
          then 
            -- Easy; just relink it all.
 
          then 
            -- Easy; just relink it all.
-           do debugTraceMsg dflags 2 (text "Upsweep completely successful.")
+           do liftIO $ debugTraceMsg dflags 2 (text "Upsweep completely successful.")
 
              -- Clean up after ourselves
 
              -- Clean up after ourselves
-             cleanTempFilesExcept dflags (ppFilesFromSummaries modsDone)
+             liftIO $ cleanTempFilesExcept dflags (ppFilesFromSummaries modsDone)
 
              -- Issue a warning for the confusing case where the user
              -- said '-o foo' but we're not going to do any linking.
 
              -- Issue a warning for the confusing case where the user
              -- said '-o foo' but we're not going to do any linking.
@@ -689,26 +873,26 @@ load2 s@(Session ref) how_much mod_graph = do
              let 
                main_mod = mainModIs dflags
                a_root_is_Main = any ((==main_mod).ms_mod) mod_graph
              let 
                main_mod = mainModIs dflags
                a_root_is_Main = any ((==main_mod).ms_mod) mod_graph
-               do_linking = a_root_is_Main || no_hs_main
+               do_linking = a_root_is_Main || no_hs_main || ghcLink dflags == LinkDynLib
 
              when (ghcLink dflags == LinkBinary 
                     && isJust ofile && not do_linking) $
 
              when (ghcLink dflags == LinkBinary 
                     && isJust ofile && not do_linking) $
-               debugTraceMsg dflags 1 $
+               liftIO $ debugTraceMsg dflags 1 $
                     text ("Warning: output was redirected with -o, " ++
                           "but no output will be generated\n" ++
                          "because there is no " ++ 
                           moduleNameString (moduleName main_mod) ++ " module.")
 
              -- link everything together
                     text ("Warning: output was redirected with -o, " ++
                           "but no output will be generated\n" ++
                          "because there is no " ++ 
                           moduleNameString (moduleName main_mod) ++ " module.")
 
              -- link everything together
-              linkresult <- link (ghcLink dflags) dflags do_linking (hsc_HPT hsc_env1)
+              linkresult <- liftIO $ link (ghcLink dflags) dflags do_linking (hsc_HPT hsc_env1)
 
 
-             loadFinish Succeeded linkresult ref hsc_env1
+             loadFinish Succeeded linkresult hsc_env1
 
          else 
            -- Tricky.  We need to back out the effects of compiling any
            -- half-done cycles, both so as to clean up the top level envs
            -- and to avoid telling the interactive linker to link them.
 
          else 
            -- Tricky.  We need to back out the effects of compiling any
            -- half-done cycles, both so as to clean up the top level envs
            -- and to avoid telling the interactive linker to link them.
-           do debugTraceMsg dflags 2 (text "Upsweep partially successful.")
+           do liftIO $ debugTraceMsg dflags 2 (text "Upsweep partially successful.")
 
               let modsDone_names
                      = map ms_mod modsDone
 
               let modsDone_names
                      = map ms_mod modsDone
@@ -723,31 +907,33 @@ load2 s@(Session ref) how_much mod_graph = do
                                              (hsc_HPT hsc_env1)
 
              -- Clean up after ourselves
                                              (hsc_HPT hsc_env1)
 
              -- Clean up after ourselves
-             cleanTempFilesExcept dflags (ppFilesFromSummaries mods_to_keep)
+             liftIO $ cleanTempFilesExcept dflags (ppFilesFromSummaries mods_to_keep)
 
              -- there should be no Nothings where linkables should be, now
              ASSERT(all (isJust.hm_linkable) 
                        (eltsUFM (hsc_HPT hsc_env))) do
        
              -- Link everything together
 
              -- there should be no Nothings where linkables should be, now
              ASSERT(all (isJust.hm_linkable) 
                        (eltsUFM (hsc_HPT hsc_env))) do
        
              -- Link everything together
-              linkresult <- link (ghcLink dflags) dflags False hpt4
+              linkresult <- liftIO $ link (ghcLink dflags) dflags False hpt4
 
              let hsc_env4 = hsc_env1{ hsc_HPT = hpt4 }
 
              let hsc_env4 = hsc_env1{ hsc_HPT = hpt4 }
-             loadFinish Failed linkresult ref hsc_env4
+             loadFinish Failed linkresult hsc_env4
 
 -- Finish up after a load.
 
 -- If the link failed, unload everything and return.
 
 -- Finish up after a load.
 
 -- If the link failed, unload everything and return.
-loadFinish :: SuccessFlag -> SuccessFlag -> IORef HscEnv -> HscEnv -> IO SuccessFlag
-loadFinish _all_ok Failed ref hsc_env
-  = do unload hsc_env []
-       writeIORef ref $! discardProg hsc_env
+loadFinish :: GhcMonad m =>
+              SuccessFlag -> SuccessFlag -> HscEnv
+           -> m SuccessFlag
+loadFinish _all_ok Failed hsc_env
+  = do liftIO $ unload hsc_env []
+       modifySession $ \_ -> discardProg hsc_env
        return Failed
 
 -- Empty the interactive context and set the module context to the topmost
 -- newly loaded module, or the Prelude if none were loaded.
        return Failed
 
 -- Empty the interactive context and set the module context to the topmost
 -- newly loaded module, or the Prelude if none were loaded.
-loadFinish all_ok Succeeded ref hsc_env
-  = do writeIORef ref $! hsc_env{ hsc_IC = emptyInteractiveContext }
+loadFinish all_ok Succeeded hsc_env
+  = do modifySession $ \_ -> hsc_env{ hsc_IC = emptyInteractiveContext }
        return all_ok
 
 
        return all_ok
 
 
@@ -765,24 +951,77 @@ ppFilesFromSummaries :: [ModSummary] -> [FilePath]
 ppFilesFromSummaries summaries = map ms_hspp_file summaries
 
 -- -----------------------------------------------------------------------------
 ppFilesFromSummaries summaries = map ms_hspp_file summaries
 
 -- -----------------------------------------------------------------------------
--- Check module
-
-data CheckedModule = 
-  CheckedModule { parsedSource      :: ParsedSource,
-                 renamedSource     :: Maybe RenamedSource,
-                 typecheckedSource :: Maybe TypecheckedSource,
-                 checkedModuleInfo :: Maybe ModuleInfo,
-                  coreBinds         :: Maybe [CoreBind]
-               }
+
+class ParsedMod m where
+  modSummary   :: m -> ModSummary
+  parsedSource :: m -> ParsedSource
+
+class ParsedMod m => TypecheckedMod m where
+  renamedSource     :: m -> Maybe RenamedSource
+  typecheckedSource :: m -> TypecheckedSource
+  moduleInfo        :: m -> ModuleInfo
+  tm_internals      :: m -> (TcGblEnv, ModDetails)
        -- ToDo: improvements that could be made here:
        --  if the module succeeded renaming but not typechecking,
        --  we can still get back the GlobalRdrEnv and exports, so
        --  perhaps the ModuleInfo should be split up into separate
        -- ToDo: improvements that could be made here:
        --  if the module succeeded renaming but not typechecking,
        --  we can still get back the GlobalRdrEnv and exports, so
        --  perhaps the ModuleInfo should be split up into separate
-       --  fields within CheckedModule.
+       --  fields.
+
+class TypecheckedMod m => DesugaredMod m where
+  coreModule :: m -> ModGuts
+
+-- | The result of successful parsing.
+data ParsedModule =
+  ParsedModule { pm_mod_summary   :: ModSummary
+               , pm_parsed_source :: ParsedSource }
+
+instance ParsedMod ParsedModule where
+  modSummary m    = pm_mod_summary m
+  parsedSource m = pm_parsed_source m
+
+-- | The result of successful typechecking.  It also contains the parser
+--   result.
+data TypecheckedModule =
+  TypecheckedModule { tm_parsed_module       :: ParsedModule
+                    , tm_renamed_source      :: Maybe RenamedSource
+                    , tm_typechecked_source  :: TypecheckedSource
+                    , tm_checked_module_info :: ModuleInfo
+                    , tm_internals_          :: (TcGblEnv, ModDetails)
+                    }
+
+instance ParsedMod TypecheckedModule where
+  modSummary m   = modSummary (tm_parsed_module m)
+  parsedSource m = parsedSource (tm_parsed_module m)
+
+instance TypecheckedMod TypecheckedModule where
+  renamedSource m     = tm_renamed_source m
+  typecheckedSource m = tm_typechecked_source m
+  moduleInfo m = tm_checked_module_info m
+  tm_internals m      = tm_internals_ m
+
+-- | The result of successful desugaring (i.e., translation to core).  Also
+--  contains all the information of a typechecked module.
+data DesugaredModule =
+  DesugaredModule { dm_typechecked_module :: TypecheckedModule
+                  , dm_core_module        :: ModGuts
+             }
+
+instance ParsedMod DesugaredModule where
+  modSummary m   = modSummary (dm_typechecked_module m)
+  parsedSource m = parsedSource (dm_typechecked_module m)
+
+instance TypecheckedMod DesugaredModule where
+  renamedSource m     = renamedSource (dm_typechecked_module m)
+  typecheckedSource m = typecheckedSource (dm_typechecked_module m)
+  moduleInfo m        = moduleInfo (dm_typechecked_module m)
+  tm_internals m      = tm_internals_ (dm_typechecked_module m)
+
+instance DesugaredMod DesugaredModule where
+  coreModule m = dm_core_module m
 
 type ParsedSource      = Located (HsModule RdrName)
 type RenamedSource     = (HsGroup Name, [LImportDecl Name], Maybe [LIE Name],
 
 type ParsedSource      = Located (HsModule RdrName)
 type RenamedSource     = (HsGroup Name, [LImportDecl Name], Maybe [LIE Name],
-                          Maybe (HsDoc Name), HaddockModInfo Name)
+                          Maybe LHsDocString)
 type TypecheckedSource = LHsBinds Id
 
 -- NOTE:
 type TypecheckedSource = LHsBinds Id
 
 -- NOTE:
@@ -797,77 +1036,235 @@ type TypecheckedSource = LHsBinds Id
 --     - default methods are turned into top-level decls.
 --     - dictionary bindings
 
 --     - default methods are turned into top-level decls.
 --     - dictionary bindings
 
-
--- | This is the way to get access to parsed and typechecked source code
--- for a module.  'checkModule' attempts to typecheck the module.  If
--- successful, it returns the abstract syntax for the module.
--- If compileToCore is true, it also desugars the module and returns the 
--- resulting Core bindings as a component of the CheckedModule.
-checkModule :: Session -> ModuleName -> Bool -> IO (Maybe CheckedModule)
-checkModule (Session ref) mod compileToCore = do
-       -- parse & typecheck the module
-   hsc_env <- readIORef ref   
-   let mg  = hsc_mod_graph hsc_env
-   case [ ms | ms <- mg, ms_mod_name ms == mod ] of
-       [] -> return Nothing
-       (ms:_) -> do 
-          mbChecked <- hscFileCheck 
-                          hsc_env{hsc_dflags=ms_hspp_opts ms} 
-                          ms compileToCore
-          case mbChecked of
-             Nothing -> return Nothing
-             Just (HscChecked parsed renamed Nothing _) ->
-                  return (Just (CheckedModule {
-                                       parsedSource = parsed,
-                                       renamedSource = renamed,
-                                       typecheckedSource = Nothing,
-                                       checkedModuleInfo = Nothing,
-                                        coreBinds = Nothing }))
-             Just (HscChecked parsed renamed
-                          (Just (tc_binds, rdr_env, details))
-                           maybeCoreBinds) -> do
-                  let minf = ModuleInfo {
-                               minf_type_env  = md_types details,
-                               minf_exports   = availsToNameSet $
-                                                     md_exports details,
-                               minf_rdr_env   = Just rdr_env,
-                               minf_instances = md_insts details
+-- | Return the 'ModSummary' of a module with the given name.
+--
+-- The module must be part of the module graph (see 'hsc_mod_graph' and
+-- 'ModuleGraph').  If this is not the case, this function will throw a
+-- 'GhcApiError'.
+--
+-- This function ignores boot modules and requires that there is only one
+-- non-boot module with the given name.
+getModSummary :: GhcMonad m => ModuleName -> m ModSummary
+getModSummary mod = do
+   mg <- liftM hsc_mod_graph getSession
+   case [ ms | ms <- mg, ms_mod_name ms == mod, not (isBootSummary ms) ] of
+     [] -> throw $ mkApiErr (text "Module not part of module graph")
+     [ms] -> return ms
+     multiple -> throw $ mkApiErr (text "getModSummary is ambiguous: " <+> ppr multiple)
+
+-- | Parse a module.
+--
+-- Throws a 'SourceError' on parse error.
+parseModule :: GhcMonad m => ModSummary -> m ParsedModule
+parseModule ms = do
+   rdr_module <- withTempSession
+                     (\e -> e { hsc_dflags = ms_hspp_opts ms }) $
+                   hscParse ms
+   return (ParsedModule ms rdr_module)
+
+-- | Typecheck and rename a parsed module.
+--
+-- Throws a 'SourceError' if either fails.
+typecheckModule :: GhcMonad m => ParsedModule -> m TypecheckedModule
+typecheckModule pmod = do
+ let ms = modSummary pmod
+ withTempSession (\e -> e { hsc_dflags = ms_hspp_opts ms }) $ do
+   (tc_gbl_env, rn_info)
+       <- hscTypecheckRename ms (parsedSource pmod)
+   details <- makeSimpleDetails tc_gbl_env
+   return $
+     TypecheckedModule {
+       tm_internals_          = (tc_gbl_env, details),
+       tm_parsed_module       = pmod,
+       tm_renamed_source      = rn_info,
+       tm_typechecked_source  = tcg_binds tc_gbl_env,
+       tm_checked_module_info =
+         ModuleInfo {
+           minf_type_env  = md_types details,
+           minf_exports   = availsToNameSet $ md_exports details,
+           minf_rdr_env   = Just (tcg_rdr_env tc_gbl_env),
+           minf_instances = md_insts details
 #ifdef GHCI
 #ifdef GHCI
-                               ,minf_modBreaks = emptyModBreaks 
+           ,minf_modBreaks = emptyModBreaks
 #endif
 #endif
-                             }
-                  return (Just (CheckedModule {
-                                       parsedSource = parsed,
-                                       renamedSource = renamed,
-                                       typecheckedSource = Just tc_binds,
-                                       checkedModuleInfo = Just minf,
-                                        coreBinds = maybeCoreBinds}))
+         }}
+
+-- | Desugar a typechecked module.
+desugarModule :: GhcMonad m => TypecheckedModule -> m DesugaredModule
+desugarModule tcm = do
+ let ms = modSummary tcm
+ withTempSession (\e -> e { hsc_dflags = ms_hspp_opts ms }) $ do
+   let (tcg, _) = tm_internals tcm
+   guts <- hscDesugar ms tcg
+   return $
+     DesugaredModule {
+       dm_typechecked_module = tcm,
+       dm_core_module        = guts
+     }
+
+-- | Load a module.  Input doesn't need to be desugared.
+--
+-- A module must be loaded before dependent modules can be typechecked.  This
+-- always includes generating a 'ModIface' and, depending on the
+-- 'DynFlags.hscTarget', may also include code generation.
+--
+-- This function will always cause recompilation and will always overwrite
+-- previous compilation results (potentially files on disk).
+--
+loadModule :: (TypecheckedMod mod, GhcMonad m) => mod -> m mod
+loadModule tcm = do
+   let ms = modSummary tcm
+   let mod = ms_mod_name ms
+   let (tcg, _details) = tm_internals tcm
+   hpt_new <-
+       withTempSession (\e -> e { hsc_dflags = ms_hspp_opts ms }) $ do
+
+         let compilerBackend comp env ms' _ _mb_old_iface _ =
+               withTempSession (\_ -> env) $
+                 hscBackend comp tcg ms'
+                            Nothing
+         hsc_env <- getSession
+         mod_info
+             <- compile' (compilerBackend hscNothingCompiler
+                         ,compilerBackend hscInteractiveCompiler
+                         ,compilerBackend hscBatchCompiler)
+                         hsc_env ms 1 1 Nothing Nothing
+         -- compile' shouldn't change the environment
+         return $ addToUFM (hsc_HPT hsc_env) mod mod_info
+   modifySession $ \e -> e{ hsc_HPT = hpt_new }
+   return tcm
 
 -- | This is the way to get access to the Core bindings corresponding
 
 -- | This is the way to get access to the Core bindings corresponding
--- to a module. 'compileToCore' invokes 'checkModule' to parse, typecheck, and
--- desugar the module, then returns the resulting list of Core bindings if 
--- successful. 
-compileToCore :: Session -> FilePath -> IO (Maybe [CoreBind])
-compileToCore session fn = do
+-- to a module. 'compileToCore' parses, typechecks, and
+-- desugars the module, then returns the resulting Core module (consisting of
+-- the module name, type declarations, and function declarations) if
+-- successful.
+compileToCoreModule :: GhcMonad m => FilePath -> m CoreModule
+compileToCoreModule = compileCore False
+
+-- | Like compileToCoreModule, but invokes the simplifier, so
+-- as to return simplified and tidied Core.
+compileToCoreSimplified :: GhcMonad m => FilePath -> m CoreModule
+compileToCoreSimplified = compileCore True
+{-
+-- | Provided for backwards-compatibility: compileToCore returns just the Core
+-- bindings, but for most purposes, you probably want to call
+-- compileToCoreModule.
+compileToCore :: GhcMonad m => FilePath -> m [CoreBind]
+compileToCore fn = do
+   mod <- compileToCoreModule session fn
+   return $ cm_binds mod
+-}
+-- | Takes a CoreModule and compiles the bindings therein
+-- to object code. The first argument is a bool flag indicating
+-- whether to run the simplifier.
+-- The resulting .o, .hi, and executable files, if any, are stored in the
+-- current directory, and named according to the module name.
+-- This has only so far been tested with a single self-contained module.
+compileCoreToObj :: GhcMonad m => Bool -> CoreModule -> m ()
+compileCoreToObj simplify cm@(CoreModule{ cm_module = mName }) = do
+  dflags      <- getSessionDynFlags
+  currentTime <- liftIO $ getClockTime
+  cwd         <- liftIO $ getCurrentDirectory
+  modLocation <- liftIO $ mkHiOnlyModLocation dflags (hiSuf dflags) cwd
+                   ((moduleNameSlashes . moduleName) mName)
+
+  let modSummary = ModSummary { ms_mod = mName,
+         ms_hsc_src = ExtCoreFile,
+         ms_location = modLocation,
+         -- By setting the object file timestamp to Nothing,
+         -- we always force recompilation, which is what we
+         -- want. (Thus it doesn't matter what the timestamp
+         -- for the (nonexistent) source file is.)
+         ms_hs_date = currentTime,
+         ms_obj_date = Nothing,
+         -- Only handling the single-module case for now, so no imports.
+         ms_srcimps = [],
+         ms_imps = [],
+         -- No source file
+         ms_hspp_file = "",
+         ms_hspp_opts = dflags,
+         ms_hspp_buf = Nothing
+      }
+
+  let maybe_simplify mod_guts | simplify = hscSimplify mod_guts
+                              | otherwise = return mod_guts
+  guts <- maybe_simplify (mkModGuts cm)
+  (iface, changed, _details, cgguts)
+      <- hscNormalIface guts Nothing
+  hscWriteIface iface changed modSummary
+  _ <- hscGenHardCode cgguts modSummary
+  return ()
+
+-- Makes a "vanilla" ModGuts.
+mkModGuts :: CoreModule -> ModGuts
+mkModGuts coreModule = ModGuts {
+  mg_module = cm_module coreModule,
+  mg_boot = False,
+  mg_exports = [],
+  mg_deps = noDependencies,
+  mg_dir_imps = emptyModuleEnv,
+  mg_used_names = emptyNameSet,
+  mg_rdr_env = emptyGlobalRdrEnv,
+  mg_fix_env = emptyFixityEnv,
+  mg_types = emptyTypeEnv,
+  mg_insts = [],
+  mg_fam_insts = [],
+  mg_rules = [],
+  mg_binds = cm_binds coreModule,
+  mg_foreign = NoStubs,
+  mg_warns = NoWarnings,
+  mg_anns = [],
+  mg_hpc_info = emptyHpcInfo False,
+  mg_modBreaks = emptyModBreaks,
+  mg_vect_info = noVectInfo,
+  mg_inst_env = emptyInstEnv,
+  mg_fam_inst_env = emptyFamInstEnv
+}
+
+compileCore :: GhcMonad m => Bool -> FilePath -> m CoreModule
+compileCore simplify fn = do
    -- First, set the target to the desired filename
    target <- guessTarget fn Nothing
    -- First, set the target to the desired filename
    target <- guessTarget fn Nothing
-   addTarget session target
-   load session LoadAllTargets
+   addTarget target
+   _ <- load LoadAllTargets
    -- Then find dependencies
    -- Then find dependencies
-   maybeModGraph <- depanal session [] True
-   case maybeModGraph of
-     Nothing -> return Nothing
-     Just modGraph -> do
-        let modSummary = expectJust "compileToCore" $
-                          find ((== fn) . msHsFilePath) modGraph
-        -- Now we have the module name;
-        -- parse, typecheck and desugar the module
-        let mod = ms_mod_name modSummary
-        maybeCheckedModule <- checkModule session mod True
-        case maybeCheckedModule of
-             Nothing -> return Nothing 
-             Just checkedMod -> return $ coreBinds checkedMod
- -- ---------------------------------------------------------------------------
+   modGraph <- depanal [] True
+   case find ((== fn) . msHsFilePath) modGraph of
+     Just modSummary -> do
+       -- Now we have the module name;
+       -- parse, typecheck and desugar the module
+       mod_guts <- coreModule `fmap`
+                      -- TODO: space leaky: call hsc* directly?
+                      (desugarModule =<< typecheckModule =<< parseModule modSummary)
+       liftM gutsToCoreModule $
+         if simplify
+          then do
+             -- If simplify is true: simplify (hscSimplify), then tidy
+             -- (tidyProgram).
+             hsc_env <- getSession
+             simpl_guts <- hscSimplify mod_guts
+             tidy_guts <- liftIO $ tidyProgram hsc_env simpl_guts
+             return $ Left tidy_guts
+          else
+             return $ Right mod_guts
+
+     Nothing -> panic "compileToCoreModule: target FilePath not found in\
+                           module dependency graph"
+  where -- two versions, based on whether we simplify (thus run tidyProgram,
+        -- which returns a (CgGuts, ModDetails) pair, or not (in which case
+        -- we just have a ModGuts.
+        gutsToCoreModule :: Either (CgGuts, ModDetails) ModGuts -> CoreModule
+        gutsToCoreModule (Left (cg, md))  = CoreModule {
+          cm_module = cg_module cg,    cm_types = md_types md,
+          cm_imports = cg_dir_imps cg, cm_binds = cg_binds cg
+        }
+        gutsToCoreModule (Right mg) = CoreModule {
+          cm_module  = mg_module mg,                   cm_types   = mg_types mg,
+          cm_imports = moduleEnvKeys (mg_dir_imps mg), cm_binds   = mg_binds mg
+         }
+
+-- ---------------------------------------------------------------------------
 -- Unloading
 
 unload :: HscEnv -> [Linkable] -> IO ()
 -- Unloading
 
 unload :: HscEnv -> [Linkable] -> IO ()
@@ -883,9 +1280,9 @@ unload hsc_env stable_linkables    -- Unload everthing *except* 'stable_linkables'
        _other -> return ()
 
 -- -----------------------------------------------------------------------------
        _other -> return ()
 
 -- -----------------------------------------------------------------------------
--- checkStability
 
 
-{-
+{- |
+
   Stability tells us which modules definitely do not need to be recompiled.
   There are two main reasons for having stability:
   
   Stability tells us which modules definitely do not need to be recompiled.
   There are two main reasons for having stability:
   
@@ -900,7 +1297,7 @@ unload hsc_env stable_linkables    -- Unload everthing *except* 'stable_linkables'
   The stability check is as follows.  Both stableObject and
   stableBCO are used during the upsweep phase later.
 
   The stability check is as follows.  Both stableObject and
   stableBCO are used during the upsweep phase later.
 
-  -------------------
+@
   stable m = stableObject m || stableBCO m
 
   stableObject m = 
   stable m = stableObject m || stableBCO m
 
   stableObject m = 
@@ -911,21 +1308,23 @@ unload hsc_env stable_linkables  -- Unload everthing *except* 'stable_linkables'
   stableBCO m =
        all stable (imports m)
        && date(BCO) > date(.hs)
   stableBCO m =
        all stable (imports m)
        && date(BCO) > date(.hs)
-  -------------------    
+@
 
   These properties embody the following ideas:
 
     - if a module is stable, then:
 
   These properties embody the following ideas:
 
     - if a module is stable, then:
+
        - if it has been compiled in a previous pass (present in HPT)
          then it does not need to be compiled or re-linked.
        - if it has been compiled in a previous pass (present in HPT)
          then it does not need to be compiled or re-linked.
+
         - if it has not been compiled in a previous pass,
          then we only need to read its .hi file from disk and
         - if it has not been compiled in a previous pass,
          then we only need to read its .hi file from disk and
-         link it to produce a ModDetails.
+         link it to produce a 'ModDetails'.
 
     - if a modules is not stable, we will definitely be at least
 
     - if a modules is not stable, we will definitely be at least
-      re-linking, and possibly re-compiling it during the upsweep.
+      re-linking, and possibly re-compiling it during the 'upsweep'.
       All non-stable modules can (and should) therefore be unlinked
       All non-stable modules can (and should) therefore be unlinked
-      before the upsweep.
+      before the 'upsweep'.
 
     - Note that objects are only considered stable if they only depend
       on other objects.  We can't link object code against byte code.
 
     - Note that objects are only considered stable if they only depend
       on other objects.  We can't link object code against byte code.
@@ -949,7 +1348,7 @@ checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs
        scc_mods = map ms_mod_name scc
        home_module m   = m `elem` all_home_mods && m `notElem` scc_mods
 
        scc_mods = map ms_mod_name scc
        home_module m   = m `elem` all_home_mods && m `notElem` scc_mods
 
-        scc_allimps = nub (filter home_module (concatMap ms_allimps scc))
+        scc_allimps = nub (filter home_module (concatMap ms_home_allimps scc))
            -- all imports outside the current SCC, but in the home pkg
        
        stable_obj_imps = map (`elem` stable_obj) scc_allimps
            -- all imports outside the current SCC, but in the home pkg
        
        stable_obj_imps = map (`elem` stable_obj) scc_allimps
@@ -986,12 +1385,10 @@ checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs
                        linkableTime l >= ms_hs_date ms
                _other  -> False
 
                        linkableTime l >= ms_hs_date ms
                _other  -> False
 
-ms_allimps :: ModSummary -> [ModuleName]
-ms_allimps ms = map unLoc (ms_srcimps ms ++ ms_imps ms)
-
 -- -----------------------------------------------------------------------------
 -- -----------------------------------------------------------------------------
--- Prune the HomePackageTable
 
 
+-- | Prune the HomePackageTable
+--
 -- Before doing an upsweep, we can throw away:
 --
 --   - For non-stable modules:
 -- Before doing an upsweep, we can throw away:
 --
 --   - For non-stable modules:
@@ -1050,22 +1447,29 @@ findPartiallyCompletedCycles modsDone theGraph
              else chewed_rest
 
 -- -----------------------------------------------------------------------------
              else chewed_rest
 
 -- -----------------------------------------------------------------------------
--- The upsweep
 
 
+-- | The upsweep
+--
 -- This is where we compile each module in the module graph, in a pass
 -- from the bottom to the top of the graph.
 -- This is where we compile each module in the module graph, in a pass
 -- from the bottom to the top of the graph.
-
+--
 -- There better had not be any cyclic groups here -- we check for them.
 
 upsweep
 -- There better had not be any cyclic groups here -- we check for them.
 
 upsweep
-    :: HscEnv                  -- Includes initially-empty HPT
-    -> HomePackageTable                -- HPT from last time round (pruned)
-    -> ([ModuleName],[ModuleName]) -- stable modules (see checkStability)
-    -> IO ()                   -- How to clean up unwanted tmp files
-    -> [SCC ModSummary]                -- Mods to do (the worklist)
-    -> IO (SuccessFlag,
-           HscEnv,             -- With an updated HPT
-           [ModSummary])       -- Mods which succeeded
+    :: GhcMonad m =>
+       HscEnv                  -- ^ Includes initially-empty HPT
+    -> HomePackageTable                -- ^ HPT from last time round (pruned)
+    -> ([ModuleName],[ModuleName]) -- ^ stable modules (see checkStability)
+    -> IO ()                   -- ^ How to clean up unwanted tmp files
+    -> [SCC ModSummary]                -- ^ Mods to do (the worklist)
+    -> m (SuccessFlag,
+         HscEnv,
+         [ModSummary])
+       -- ^ Returns:
+       --
+       --  1. A flag whether the complete upsweep was successful.
+       --  2. The 'HscEnv' with an updated HPT
+       --  3. A list of modules which succeeded loading.
 
 upsweep hsc_env old_hpt stable_mods cleanup sccs = do
    (res, hsc_env, done) <- upsweep' hsc_env old_hpt [] sccs 1 (length sccs)
 
 upsweep hsc_env old_hpt stable_mods cleanup sccs = do
    (res, hsc_env, done) <- upsweep' hsc_env old_hpt [] sccs 1 (length sccs)
@@ -1078,7 +1482,7 @@ upsweep hsc_env old_hpt stable_mods cleanup sccs = do
 
   upsweep' hsc_env _old_hpt done
      (CyclicSCC ms:_) _ _
 
   upsweep' hsc_env _old_hpt done
      (CyclicSCC ms:_) _ _
-   = do fatalErrorMsg (hsc_dflags hsc_env) (cyclicModuleErr ms)
+   = do liftIO $ fatalErrorMsg (hsc_dflags hsc_env) (cyclicModuleErr ms)
         return (Failed, hsc_env, done)
 
   upsweep' hsc_env old_hpt done
         return (Failed, hsc_env, done)
 
   upsweep' hsc_env old_hpt done
@@ -1086,15 +1490,21 @@ upsweep hsc_env old_hpt stable_mods cleanup sccs = do
    = do -- putStrLn ("UPSWEEP_MOD: hpt = " ++ 
        --           show (map (moduleUserString.moduleName.mi_module.hm_iface) 
        --                     (moduleEnvElts (hsc_HPT hsc_env)))
    = do -- putStrLn ("UPSWEEP_MOD: hpt = " ++ 
        --           show (map (moduleUserString.moduleName.mi_module.hm_iface) 
        --                     (moduleEnvElts (hsc_HPT hsc_env)))
+        let logger = reportModuleCompilationResult (hsc_callbacks hsc_env)
 
 
-        mb_mod_info <- upsweep_mod hsc_env old_hpt stable_mods mod 
-                       mod_index nmods
+        mb_mod_info
+            <- handleSourceError
+                   (\err -> do logger mod (Just err); return Nothing) $ do
+                 mod_info <- upsweep_mod hsc_env old_hpt stable_mods
+                                         mod mod_index nmods
+                 logger mod Nothing -- log warnings
+                 return (Just mod_info)
 
 
-       cleanup         -- Remove unwanted tmp files between compilations
+        liftIO cleanup -- Remove unwanted tmp files between compilations
 
         case mb_mod_info of
 
         case mb_mod_info of
-           Nothing -> return (Failed, hsc_env, [])
-           Just mod_info -> do 
+          Nothing -> return (Failed, hsc_env, done)
+          Just mod_info -> do
                let this_mod = ms_mod_name mod
 
                        -- Add new info to hsc_env
                let this_mod = ms_mod_name mod
 
                        -- Add new info to hsc_env
@@ -1115,20 +1525,20 @@ upsweep hsc_env old_hpt stable_mods cleanup sccs = do
 
                         -- fixup our HomePackageTable after we've finished compiling
                         -- a mutually-recursive loop.  See reTypecheckLoop, below.
 
                         -- fixup our HomePackageTable after we've finished compiling
                         -- a mutually-recursive loop.  See reTypecheckLoop, below.
-                hsc_env2 <- reTypecheckLoop hsc_env1 mod done'
+                hsc_env2 <- liftIO $ reTypecheckLoop hsc_env1 mod done'
 
                upsweep' hsc_env2 old_hpt1 done' mods (mod_index+1) nmods
 
 
                upsweep' hsc_env2 old_hpt1 done' mods (mod_index+1) nmods
 
-
--- Compile a single module.  Always produce a Linkable for it if 
+-- | Compile a single module.  Always produce a Linkable for it if
 -- successful.  If no compilation happened, return the old Linkable.
 -- successful.  If no compilation happened, return the old Linkable.
-upsweep_mod :: HscEnv
+upsweep_mod :: GhcMonad m =>
+               HscEnv
             -> HomePackageTable
            -> ([ModuleName],[ModuleName])
             -> ModSummary
             -> Int  -- index of module
             -> Int  -- total number of modules
             -> HomePackageTable
            -> ([ModuleName],[ModuleName])
             -> ModSummary
             -> Int  -- index of module
             -> Int  -- total number of modules
-            -> IO (Maybe HomeModInfo)  -- Nothing => Failed
+            -> m HomeModInfo
 
 upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) summary mod_index nmods
    =    let 
 
 upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) summary mod_index nmods
    =    let 
@@ -1180,70 +1590,99 @@ upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) summary mod_index nmods
                                   where 
                                     iface = hm_iface hm_info
 
                                   where 
                                     iface = hm_iface hm_info
 
-           compile_it :: Maybe Linkable -> IO (Maybe HomeModInfo)
+           compile_it :: GhcMonad m => Maybe Linkable -> m HomeModInfo
            compile_it  = compile hsc_env summary' mod_index nmods mb_old_iface
 
            compile_it  = compile hsc_env summary' mod_index nmods mb_old_iface
 
+            compile_it_discard_iface :: GhcMonad m =>
+                                        Maybe Linkable -> m HomeModInfo
             compile_it_discard_iface 
                         = compile hsc_env summary' mod_index nmods Nothing
 
             compile_it_discard_iface 
                         = compile hsc_env summary' mod_index nmods Nothing
 
-        in
-       case target of
+            -- With the HscNothing target we create empty linkables to avoid
+            -- recompilation.  We have to detect these to recompile anyway if
+            -- the target changed since the last compile.
+            is_fake_linkable
+               | Just hmi <- old_hmi, Just l <- hm_linkable hmi =
+                  null (linkableUnlinked l)
+               | otherwise =
+                   -- we have no linkable, so it cannot be fake
+                   False
 
 
-            _any
+            implies False _ = True
+            implies True x  = x
+
+        in
+        case () of
+         _
                 -- Regardless of whether we're generating object code or
                 -- byte code, we can always use an existing object file
                 -- if it is *stable* (see checkStability).
                 -- Regardless of whether we're generating object code or
                 -- byte code, we can always use an existing object file
                 -- if it is *stable* (see checkStability).
-               | is_stable_obj, isJust old_hmi ->
-                       return old_hmi
-                       -- object is stable, and we have an entry in the
-                       -- old HPT: nothing to do
-
-               | is_stable_obj, isNothing old_hmi -> do
-                       linkable <- findObjectLinkable this_mod obj_fn 
-                                       (expectJust "upseep1" mb_obj_date)
-                       compile_it (Just linkable)
-                       -- object is stable, but we need to load the interface
-                       -- off disk to make a HMI.
-
-            HscInterpreted
-               | is_stable_bco -> 
-                       ASSERT(isJust old_hmi) -- must be in the old_hpt
-                       return old_hmi
-                       -- BCO is stable: nothing to do
-
-               | Just hmi <- old_hmi,
-                 Just l <- hm_linkable hmi, not (isObjectLinkable l),
-                 linkableTime l >= ms_hs_date summary ->
-                       compile_it (Just l)
-                       -- we have an old BCO that is up to date with respect
-                       -- to the source: do a recompilation check as normal.
-
-               | otherwise -> 
-                        compile_it Nothing
-                       -- no existing code at all: we must recompile.
-
-              -- When generating object code, if there's an up-to-date
-              -- object file on the disk, then we can use it.
-              -- However, if the object file is new (compared to any
-              -- linkable we had from a previous compilation), then we
-              -- must discard any in-memory interface, because this
-              -- means the user has compiled the source file
-              -- separately and generated a new interface, that we must
-              -- read from the disk.
-              --
-            obj | isObjectTarget obj,
-                 Just obj_date <- mb_obj_date, obj_date >= hs_date -> do
-                     case old_hmi of
-                        Just hmi 
-                          | Just l <- hm_linkable hmi,
-                            isObjectLinkable l && linkableTime l == obj_date
-                            -> compile_it (Just l)
-                        _otherwise -> do
-                         linkable <- findObjectLinkable this_mod obj_fn obj_date
+          | is_stable_obj, Just hmi <- old_hmi -> do
+                liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
+                           (text "skipping stable obj mod:" <+> ppr this_mod_name)
+                return hmi
+                -- object is stable, and we have an entry in the
+                -- old HPT: nothing to do
+
+          | is_stable_obj, isNothing old_hmi -> do
+                liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
+                           (text "compiling stable on-disk mod:" <+> ppr this_mod_name)
+                linkable <- liftIO $ findObjectLinkable this_mod obj_fn
+                              (expectJust "upsweep1" mb_obj_date)
+                compile_it (Just linkable)
+                -- object is stable, but we need to load the interface
+                -- off disk to make a HMI.
+
+          | not (isObjectTarget target), is_stable_bco,
+            (target /= HscNothing) `implies` not is_fake_linkable ->
+                ASSERT(isJust old_hmi) -- must be in the old_hpt
+                let Just hmi = old_hmi in do
+                liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
+                           (text "skipping stable BCO mod:" <+> ppr this_mod_name)
+                return hmi
+                -- BCO is stable: nothing to do
+
+          | not (isObjectTarget target),
+            Just hmi <- old_hmi,
+            Just l <- hm_linkable hmi,
+            not (isObjectLinkable l),
+            (target /= HscNothing) `implies` not is_fake_linkable,
+            linkableTime l >= ms_hs_date summary -> do
+                liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
+                           (text "compiling non-stable BCO mod:" <+> ppr this_mod_name)
+                compile_it (Just l)
+                -- we have an old BCO that is up to date with respect
+                -- to the source: do a recompilation check as normal.
+
+          -- When generating object code, if there's an up-to-date
+          -- object file on the disk, then we can use it.
+          -- However, if the object file is new (compared to any
+          -- linkable we had from a previous compilation), then we
+          -- must discard any in-memory interface, because this
+          -- means the user has compiled the source file
+          -- separately and generated a new interface, that we must
+          -- read from the disk.
+          --
+          | isObjectTarget target,
+            Just obj_date <- mb_obj_date,
+            obj_date >= hs_date -> do
+                case old_hmi of
+                  Just hmi
+                    | Just l <- hm_linkable hmi,
+                      isObjectLinkable l && linkableTime l == obj_date -> do
+                          liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
+                                     (text "compiling mod with new on-disk obj:" <+> ppr this_mod_name)
+                          compile_it (Just l)
+                  _otherwise -> do
+                          liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
+                                     (text "compiling mod with new on-disk obj2:" <+> ppr this_mod_name)
+                          linkable <- liftIO $ findObjectLinkable this_mod obj_fn obj_date
                           compile_it_discard_iface (Just linkable)
 
                           compile_it_discard_iface (Just linkable)
 
-           _otherwise ->
-                 compile_it Nothing
+         _otherwise -> do
+                liftIO $ debugTraceMsg (hsc_dflags hsc_env) 5
+                           (text "compiling mod:" <+> ppr this_mod_name)
+                compile_it Nothing
 
 
 
 
 
 
@@ -1319,28 +1758,24 @@ typecheckLoop hsc_env mods = do
 
 reachableBackwards :: ModuleName -> [ModSummary] -> [ModSummary]
 reachableBackwards mod summaries
 
 reachableBackwards :: ModuleName -> [ModSummary] -> [ModSummary]
 reachableBackwards mod summaries
-  = [ ms | (ms,_,_) <- map vertex_fn nodes_we_want ]
-  where          
-        -- all the nodes reachable by traversing the edges backwards
-        -- from the root node:
-        nodes_we_want = reachable (transposeG graph) root
-
-        -- the rest just sets up the graph:
-       (nodes, lookup_key) = moduleGraphNodes False summaries
-       (graph, vertex_fn, key_fn) = graphFromEdges' nodes
-       root 
-         | Just key <- lookup_key HsBootFile mod, Just v <- key_fn key = v
-         | otherwise = panic "reachableBackwards"
+  = [ ms | (ms,_,_) <- reachableG (transposeG graph) root ]
+  where -- the rest just sets up the graph:
+        (graph, lookup_node) = moduleGraphNodes False summaries
+        root  = expectJust "reachableBackwards" (lookup_node HsBootFile mod)
 
 -- ---------------------------------------------------------------------------
 -- Topological sort of the module graph
 
 
 -- ---------------------------------------------------------------------------
 -- Topological sort of the module graph
 
+type SummaryNode = (ModSummary, Int, [Int])
+
 topSortModuleGraph
 topSortModuleGraph
-         :: Bool               -- Drop hi-boot nodes? (see below)
+         :: Bool
+          -- ^ Drop hi-boot nodes? (see below)
          -> [ModSummary]
          -> Maybe ModuleName
          -> [ModSummary]
          -> Maybe ModuleName
+             -- ^ Root module name.  If @Nothing@, use the full graph.
          -> [SCC ModSummary]
          -> [SCC ModSummary]
--- Calculate SCCs of the module graph, possibly dropping the hi-boot nodes
+-- ^ Calculate SCCs of the module graph, possibly dropping the hi-boot nodes
 -- The resulting list of strongly-connected-components is in topologically
 -- sorted order, starting with the module(s) at the bottom of the
 -- dependency graph (ie compile them first) and ending with the ones at
 -- The resulting list of strongly-connected-components is in topologically
 -- sorted order, starting with the module(s) at the bottom of the
 -- dependency graph (ie compile them first) and ending with the ones at
@@ -1348,73 +1783,82 @@ topSortModuleGraph
 --
 -- Drop hi-boot nodes (first boolean arg)? 
 --
 --
 -- Drop hi-boot nodes (first boolean arg)? 
 --
---   False:    treat the hi-boot summaries as nodes of the graph,
+-- - @False@:  treat the hi-boot summaries as nodes of the graph,
 --             so the graph must be acyclic
 --
 --             so the graph must be acyclic
 --
---   True:     eliminate the hi-boot nodes, and instead pretend
+-- - @True@:   eliminate the hi-boot nodes, and instead pretend
 --             the a source-import of Foo is an import of Foo
 --             the a source-import of Foo is an import of Foo
---             The resulting graph has no hi-boot nodes, but can by cyclic
-
-topSortModuleGraph drop_hs_boot_nodes summaries Nothing
-  = stronglyConnComp (fst (moduleGraphNodes drop_hs_boot_nodes summaries))
-topSortModuleGraph drop_hs_boot_nodes summaries (Just mod)
-  = stronglyConnComp (map vertex_fn (reachable graph root))
-  where 
-       -- restrict the graph to just those modules reachable from
-       -- the specified module.  We do this by building a graph with
-       -- the full set of nodes, and determining the reachable set from
-       -- the specified node.
-       (nodes, lookup_key) = moduleGraphNodes drop_hs_boot_nodes summaries
-       (graph, vertex_fn, key_fn) = graphFromEdges' nodes
-       root 
-         | Just key <- lookup_key HsSrcFile mod, Just v <- key_fn key = v
-         | otherwise  = throwDyn (ProgramError "module does not exist")
+--             The resulting graph has no hi-boot nodes, but can be cyclic
+
+topSortModuleGraph drop_hs_boot_nodes summaries mb_root_mod
+  = map (fmap summaryNodeSummary) $ stronglyConnCompG initial_graph
+  where
+    (graph, lookup_node) = moduleGraphNodes drop_hs_boot_nodes summaries
+    
+    initial_graph = case mb_root_mod of
+        Nothing -> graph
+        Just root_mod ->
+            -- restrict the graph to just those modules reachable from
+            -- the specified module.  We do this by building a graph with
+            -- the full set of nodes, and determining the reachable set from
+            -- the specified node.
+            let root | Just node <- lookup_node HsSrcFile root_mod, graph `hasVertexG` node = node
+                     | otherwise = ghcError (ProgramError "module does not exist")
+            in graphFromEdgedVertices (seq root (reachableG graph root))
+
+summaryNodeKey :: SummaryNode -> Int
+summaryNodeKey (_, k, _) = k
+
+summaryNodeSummary :: SummaryNode -> ModSummary
+summaryNodeSummary (s, _, _) = s
 
 moduleGraphNodes :: Bool -> [ModSummary]
 
 moduleGraphNodes :: Bool -> [ModSummary]
-  -> ([(ModSummary, Int, [Int])], HscSource -> ModuleName -> Maybe Int)
-moduleGraphNodes drop_hs_boot_nodes summaries = (nodes, lookup_key)
-   where
-       -- Drop hs-boot nodes by using HsSrcFile as the key
-       hs_boot_key | drop_hs_boot_nodes = HsSrcFile
-                   | otherwise          = HsBootFile   
-
-       -- We use integers as the keys for the SCC algorithm
-       nodes :: [(ModSummary, Int, [Int])]     
-       nodes = [(s, expectJust "topSort" $ 
-                       lookup_key (ms_hsc_src s) (ms_mod_name s),
-                    out_edge_keys hs_boot_key (map unLoc (ms_srcimps s)) ++
-                    out_edge_keys HsSrcFile   (map unLoc (ms_imps s)) ++
-                    (-- see [boot-edges] below
-                     if drop_hs_boot_nodes || ms_hsc_src s == HsBootFile 
-                       then [] 
-                       else case lookup_key HsBootFile (ms_mod_name s) of
-                               Nothing -> []
-                               Just k  -> [k])
-                )
-               | s <- summaries
-               , not (isBootSummary s && drop_hs_boot_nodes) ]
-               -- Drop the hi-boot ones if told to do so
-
-       -- [boot-edges] if this is a .hs and there is an equivalent
-       -- .hs-boot, add a link from the former to the latter.  This
-       -- has the effect of detecting bogus cases where the .hs-boot
-       -- depends on the .hs, by introducing a cycle.  Additionally,
-       -- it ensures that we will always process the .hs-boot before
-       -- the .hs, and so the HomePackageTable will always have the
-       -- most up to date information.
-
-       key_map :: NodeMap Int
-       key_map = listToFM ([(moduleName (ms_mod s), ms_hsc_src s)
-                           | s <- summaries]
-                          `zip` [1..])
-
-       lookup_key :: HscSource -> ModuleName -> Maybe Int
-       lookup_key hs_src mod = lookupFM key_map (mod, hs_src)
-
-       out_edge_keys :: HscSource -> [ModuleName] -> [Int]
-        out_edge_keys hi_boot ms = mapCatMaybes (lookup_key hi_boot) ms
-               -- If we want keep_hi_boot_nodes, then we do lookup_key with
-               -- the IsBootInterface parameter True; else False
+  -> (Graph SummaryNode, HscSource -> ModuleName -> Maybe SummaryNode)
+moduleGraphNodes drop_hs_boot_nodes summaries = (graphFromEdgedVertices nodes, lookup_node)
+  where
+    numbered_summaries = zip summaries [1..]
+
+    lookup_node :: HscSource -> ModuleName -> Maybe SummaryNode
+    lookup_node hs_src mod = lookupFM node_map (mod, hs_src)
+
+    lookup_key :: HscSource -> ModuleName -> Maybe Int
+    lookup_key hs_src mod = fmap summaryNodeKey (lookup_node hs_src mod)
+
+    node_map :: NodeMap SummaryNode
+    node_map = listToFM [ ((moduleName (ms_mod s), ms_hsc_src s), node)
+                        | node@(s, _, _) <- nodes ]
+
+    -- We use integers as the keys for the SCC algorithm
+    nodes :: [SummaryNode]
+    nodes = [ (s, key, out_keys)
+            | (s, key) <- numbered_summaries
+             -- Drop the hi-boot ones if told to do so
+            , not (isBootSummary s && drop_hs_boot_nodes)
+            , let out_keys = out_edge_keys hs_boot_key (map unLoc (ms_home_srcimps s)) ++
+                             out_edge_keys HsSrcFile   (map unLoc (ms_home_imps s)) ++
+                             (-- see [boot-edges] below
+                              if drop_hs_boot_nodes || ms_hsc_src s == HsBootFile 
+                              then [] 
+                              else case lookup_key HsBootFile (ms_mod_name s) of
+                                    Nothing -> []
+                                    Just k  -> [k]) ]
+
+    -- [boot-edges] if this is a .hs and there is an equivalent
+    -- .hs-boot, add a link from the former to the latter.  This
+    -- has the effect of detecting bogus cases where the .hs-boot
+    -- depends on the .hs, by introducing a cycle.  Additionally,
+    -- it ensures that we will always process the .hs-boot before
+    -- the .hs, and so the HomePackageTable will always have the
+    -- most up to date information.
+
+    -- Drop hs-boot nodes by using HsSrcFile as the key
+    hs_boot_key | drop_hs_boot_nodes = HsSrcFile
+                | otherwise          = HsBootFile
+
+    out_edge_keys :: HscSource -> [ModuleName] -> [Int]
+    out_edge_keys hi_boot ms = mapCatMaybes (lookup_key hi_boot) ms
+        -- If we want keep_hi_boot_nodes, then we do lookup_key with
+        -- the IsBootInterface parameter True; else False
 
 
 type NodeKey   = (ModuleName, HscSource)  -- The nodes of the graph are 
 
 
 type NodeKey   = (ModuleName, HscSource)  -- The nodes of the graph are 
@@ -1429,22 +1873,22 @@ mkNodeMap summaries = listToFM [ (msKey s, s) | s <- summaries]
 nodeMapElts :: NodeMap a -> [a]
 nodeMapElts = eltsFM
 
 nodeMapElts :: NodeMap a -> [a]
 nodeMapElts = eltsFM
 
--- If there are {-# SOURCE #-} imports between strongly connected
+-- | If there are {-# SOURCE #-} imports between strongly connected
 -- components in the topological sort, then those imports can
 -- definitely be replaced by ordinary non-SOURCE imports: if SOURCE
 -- were necessary, then the edge would be part of a cycle.
 -- components in the topological sort, then those imports can
 -- definitely be replaced by ordinary non-SOURCE imports: if SOURCE
 -- were necessary, then the edge would be part of a cycle.
-warnUnnecessarySourceImports :: DynFlags -> [SCC ModSummary] -> IO ()
-warnUnnecessarySourceImports dflags sccs = 
-  printBagOfWarnings dflags (listToBag (concat (map (check.flattenSCC) sccs)))
+warnUnnecessarySourceImports :: GhcMonad m => [SCC ModSummary] -> m ()
+warnUnnecessarySourceImports sccs =
+  logWarnings (listToBag (concatMap (check.flattenSCC) sccs))
   where check ms =
           let mods_in_this_cycle = map ms_mod_name ms in
   where check ms =
           let mods_in_this_cycle = map ms_mod_name ms in
-          [ warn i | m <- ms, i <- ms_srcimps m,
-                       unLoc i `notElem`  mods_in_this_cycle ]
+          [ warn i | m <- ms, i <- ms_home_srcimps m,
+                     unLoc i `notElem`  mods_in_this_cycle ]
 
        warn :: Located ModuleName -> WarnMsg
        warn (L loc mod) = 
           mkPlainErrMsg loc
 
        warn :: Located ModuleName -> WarnMsg
        warn (L loc mod) = 
           mkPlainErrMsg loc
-               (ptext SLIT("Warning: {-# SOURCE #-} unnecessary in import of ")
+               (ptext (sLit "Warning: {-# SOURCE #-} unnecessary in import of ")
                 <+> quotes (ppr mod))
 
 -----------------------------------------------------------------------------
                 <+> quotes (ppr mod))
 
 -----------------------------------------------------------------------------
@@ -1462,67 +1906,72 @@ warnUnnecessarySourceImports dflags sccs =
 -- module, plus one for any hs-boot files.  The imports of these nodes 
 -- are all there, including the imports of non-home-package modules.
 
 -- module, plus one for any hs-boot files.  The imports of these nodes 
 -- are all there, including the imports of non-home-package modules.
 
-downsweep :: HscEnv
+downsweep :: GhcMonad m =>
+             HscEnv
          -> [ModSummary]       -- Old summaries
          -> [ModuleName]       -- Ignore dependencies on these; treat
                                -- them as if they were package modules
          -> Bool               -- True <=> allow multiple targets to have 
                                --          the same module name; this is 
                                --          very useful for ghc -M
          -> [ModSummary]       -- Old summaries
          -> [ModuleName]       -- Ignore dependencies on these; treat
                                -- them as if they were package modules
          -> Bool               -- True <=> allow multiple targets to have 
                                --          the same module name; this is 
                                --          very useful for ghc -M
-         -> IO (Maybe [ModSummary])
+         -> m [ModSummary]
                -- The elts of [ModSummary] all have distinct
                -- (Modules, IsBoot) identifiers, unless the Bool is true
                -- in which case there can be repeats
 downsweep hsc_env old_summaries excl_mods allow_dup_roots
                -- The elts of [ModSummary] all have distinct
                -- (Modules, IsBoot) identifiers, unless the Bool is true
                -- in which case there can be repeats
 downsweep hsc_env old_summaries excl_mods allow_dup_roots
-   = -- catch error messages and return them
-     handleDyn (\err_msg -> printBagOfErrors (hsc_dflags hsc_env) (unitBag err_msg) >> return Nothing) $ do
+   = do -- catch error messages and return them
+     --handleErrMsg   -- should be covered by GhcMonad now
+     --          (\err_msg -> printBagOfErrors (hsc_dflags hsc_env) (unitBag err_msg) >> return Nothing) $ do
        rootSummaries <- mapM getRootSummary roots
        let root_map = mkRootMap rootSummaries
        checkDuplicates root_map
        summs <- loop (concatMap msDeps rootSummaries) root_map
        rootSummaries <- mapM getRootSummary roots
        let root_map = mkRootMap rootSummaries
        checkDuplicates root_map
        summs <- loop (concatMap msDeps rootSummaries) root_map
-       return (Just summs)
+       return summs
      where
        roots = hsc_targets hsc_env
 
        old_summary_map :: NodeMap ModSummary
        old_summary_map = mkNodeMap old_summaries
 
      where
        roots = hsc_targets hsc_env
 
        old_summary_map :: NodeMap ModSummary
        old_summary_map = mkNodeMap old_summaries
 
-       getRootSummary :: Target -> IO ModSummary
-       getRootSummary (Target (TargetFile file mb_phase) maybe_buf)
-          = do exists <- doesFileExist file
+       getRootSummary :: GhcMonad m => Target -> m ModSummary
+       getRootSummary (Target (TargetFile file mb_phase) obj_allowed maybe_buf)
+          = do exists <- liftIO $ doesFileExist file
                if exists 
                if exists 
-                   then summariseFile hsc_env old_summaries file mb_phase maybe_buf
-                   else throwDyn $ mkPlainErrMsg noSrcSpan $
+                   then summariseFile hsc_env old_summaries file mb_phase 
+                                       obj_allowed maybe_buf
+                   else throwOneError $ mkPlainErrMsg noSrcSpan $
                           text "can't find file:" <+> text file
                           text "can't find file:" <+> text file
-       getRootSummary (Target (TargetModule modl) maybe_buf)
+       getRootSummary (Target (TargetModule modl) obj_allowed maybe_buf)
           = do maybe_summary <- summariseModule hsc_env old_summary_map False 
           = do maybe_summary <- summariseModule hsc_env old_summary_map False 
-                                          (L rootLoc modl) maybe_buf excl_mods
+                                          (L rootLoc modl) obj_allowed 
+                                           maybe_buf excl_mods
                case maybe_summary of
                   Nothing -> packageModErr modl
                   Just s  -> return s
 
                case maybe_summary of
                   Nothing -> packageModErr modl
                   Just s  -> return s
 
-       rootLoc = mkGeneralSrcSpan FSLIT("<command line>")
+       rootLoc = mkGeneralSrcSpan (fsLit "<command line>")
 
        -- In a root module, the filename is allowed to diverge from the module
        -- name, so we have to check that there aren't multiple root files
        -- defining the same module (otherwise the duplicates will be silently
        -- ignored, leading to confusing behaviour).
 
        -- In a root module, the filename is allowed to diverge from the module
        -- name, so we have to check that there aren't multiple root files
        -- defining the same module (otherwise the duplicates will be silently
        -- ignored, leading to confusing behaviour).
-       checkDuplicates :: NodeMap [ModSummary] -> IO ()
+       checkDuplicates :: GhcMonad m => NodeMap [ModSummary] -> m ()
        checkDuplicates root_map 
           | allow_dup_roots = return ()
           | null dup_roots  = return ()
        checkDuplicates root_map 
           | allow_dup_roots = return ()
           | null dup_roots  = return ()
-          | otherwise       = multiRootsErr (head dup_roots)
+          | otherwise       = liftIO $ multiRootsErr (head dup_roots)
           where
             dup_roots :: [[ModSummary]]        -- Each at least of length 2
             dup_roots = filterOut isSingleton (nodeMapElts root_map)
 
           where
             dup_roots :: [[ModSummary]]        -- Each at least of length 2
             dup_roots = filterOut isSingleton (nodeMapElts root_map)
 
-       loop :: [(Located ModuleName,IsBootInterface)]
+       loop :: GhcMonad m =>
+                [(Located ModuleName,IsBootInterface)]
                        -- Work list: process these modules
             -> NodeMap [ModSummary]
                        -- Visited set; the range is a list because
                        -- the roots can have the same module names
                        -- if allow_dup_roots is True
                        -- Work list: process these modules
             -> NodeMap [ModSummary]
                        -- Visited set; the range is a list because
                        -- the roots can have the same module names
                        -- if allow_dup_roots is True
-            -> IO [ModSummary]
+            -> m [ModSummary]
                        -- The result includes the worklist, except
                        -- for those mentioned in the visited set
        loop [] done      = return (concat (nodeMapElts done))
                        -- The result includes the worklist, except
                        -- for those mentioned in the visited set
        loop [] done      = return (concat (nodeMapElts done))
@@ -1531,13 +1980,14 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots
          = if isSingleton summs then
                loop ss done
            else
          = if isSingleton summs then
                loop ss done
            else
-               do { multiRootsErr summs; return [] }
-         | otherwise         = do { mb_s <- summariseModule hsc_env old_summary_map 
-                                                is_boot wanted_mod Nothing excl_mods
-                                  ; case mb_s of
-                                       Nothing -> loop ss done
-                                       Just s  -> loop (msDeps s ++ ss) 
-                                                       (addToFM done key [s]) }
+               do { liftIO $ multiRootsErr summs; return [] }
+         | otherwise
+          = do mb_s <- summariseModule hsc_env old_summary_map 
+                                       is_boot wanted_mod True
+                                       Nothing excl_mods
+               case mb_s of
+                   Nothing -> loop ss done
+                   Just s  -> loop (msDeps s ++ ss) (addToFM done key [s])
          where
            key = (unLoc wanted_mod, if is_boot then HsBootFile else HsSrcFile)
 
          where
            key = (unLoc wanted_mod, if is_boot then HsBootFile else HsSrcFile)
 
@@ -1555,8 +2005,20 @@ msDeps :: ModSummary -> [(Located ModuleName, IsBootInterface)]
 -- Remember, this pass isn't doing the topological sort.  It's
 -- just gathering the list of all relevant ModSummaries
 msDeps s = 
 -- Remember, this pass isn't doing the topological sort.  It's
 -- just gathering the list of all relevant ModSummaries
 msDeps s = 
-    concat [ [(m,True), (m,False)] | m <- ms_srcimps s ] 
-        ++ [ (m,False) | m <- ms_imps s ] 
+    concat [ [(m,True), (m,False)] | m <- ms_home_srcimps s ] 
+        ++ [ (m,False) | m <- ms_home_imps s ] 
+
+home_imps :: [Located (ImportDecl RdrName)] -> [Located ModuleName]
+home_imps imps = [ ideclName i |  L _ i <- imps, isNothing (ideclPkgQual i) ]
+
+ms_home_allimps :: ModSummary -> [ModuleName]
+ms_home_allimps ms = map unLoc (ms_home_srcimps ms ++ ms_home_imps ms)
+
+ms_home_srcimps :: ModSummary -> [Located ModuleName]
+ms_home_srcimps = home_imps . ms_srcimps
+
+ms_home_imps :: ModSummary -> [Located ModuleName]
+ms_home_imps = home_imps . ms_imps
 
 -----------------------------------------------------------------------------
 -- Summarising modules
 
 -----------------------------------------------------------------------------
 -- Summarising modules
@@ -1572,14 +2034,16 @@ msDeps s =
 --     resides.
 
 summariseFile
 --     resides.
 
 summariseFile
-       :: HscEnv
+       :: GhcMonad m =>
+           HscEnv
        -> [ModSummary]                 -- old summaries
        -> FilePath                     -- source file name
        -> Maybe Phase                  -- start phase
        -> [ModSummary]                 -- old summaries
        -> FilePath                     -- source file name
        -> Maybe Phase                  -- start phase
+        -> Bool                         -- object code allowed?
        -> Maybe (StringBuffer,ClockTime)
        -> Maybe (StringBuffer,ClockTime)
-       -> IO ModSummary
+       -> m ModSummary
 
 
-summariseFile hsc_env old_summaries file mb_phase maybe_buf
+summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf
        -- we can use a cached summary if one is available and the
        -- source file hasn't changed,  But we have to look up the summary
        -- by source file, rather than module name as we do in summarise.
        -- we can use a cached summary if one is available and the
        -- source file hasn't changed,  But we have to look up the summary
        -- by source file, rather than module name as we do in summarise.
@@ -1590,7 +2054,7 @@ summariseFile hsc_env old_summaries file mb_phase maybe_buf
                -- return the cached summary if the source didn't change
        src_timestamp <- case maybe_buf of
                           Just (_,t) -> return t
                -- return the cached summary if the source didn't change
        src_timestamp <- case maybe_buf of
                           Just (_,t) -> return t
-                          Nothing    -> getModificationTime file
+                          Nothing    -> liftIO $ getModificationTime file
                -- The file exists; we checked in getRootSummary above.
                -- If it gets removed subsequently, then this 
                -- getModificationTime may fail, but that's the right
                -- The file exists; we checked in getRootSummary above.
                -- If it gets removed subsequently, then this 
                -- getModificationTime may fail, but that's the right
@@ -1598,7 +2062,11 @@ summariseFile hsc_env old_summaries file mb_phase maybe_buf
 
        if ms_hs_date old_summary == src_timestamp 
           then do -- update the object-file timestamp
 
        if ms_hs_date old_summary == src_timestamp 
           then do -- update the object-file timestamp
-                 obj_timestamp <- getObjTimestamp location False
+                 obj_timestamp <-
+                    if isObjectTarget (hscTarget (hsc_dflags hsc_env)) 
+                        || obj_allowed -- bug #1205
+                        then liftIO $ getObjTimestamp location False
+                        else return Nothing
                  return old_summary{ ms_obj_date = obj_timestamp }
           else
                new_summary
                  return old_summary{ ms_obj_date = obj_timestamp }
           else
                new_summary
@@ -1610,23 +2078,29 @@ summariseFile hsc_env old_summaries file mb_phase maybe_buf
        let dflags = hsc_dflags hsc_env
 
        (dflags', hspp_fn, buf)
        let dflags = hsc_dflags hsc_env
 
        (dflags', hspp_fn, buf)
-           <- preprocessFile dflags file mb_phase maybe_buf
+           <- preprocessFile hsc_env file mb_phase maybe_buf
 
         (srcimps,the_imps, L _ mod_name) <- getImports dflags' buf hspp_fn file
 
        -- Make a ModLocation for this file
 
         (srcimps,the_imps, L _ mod_name) <- getImports dflags' buf hspp_fn file
 
        -- Make a ModLocation for this file
-       location <- mkHomeModLocation dflags mod_name file
+       location <- liftIO $ mkHomeModLocation dflags mod_name file
 
        -- Tell the Finder cache where it is, so that subsequent calls
        -- to findModule will find it, even if it's not on any search path
 
        -- Tell the Finder cache where it is, so that subsequent calls
        -- to findModule will find it, even if it's not on any search path
-       mod <- addHomeModuleToFinder hsc_env mod_name location
+       mod <- liftIO $ addHomeModuleToFinder hsc_env mod_name location
 
         src_timestamp <- case maybe_buf of
                           Just (_,t) -> return t
 
         src_timestamp <- case maybe_buf of
                           Just (_,t) -> return t
-                          Nothing    -> getModificationTime file
+                          Nothing    -> liftIO $ getModificationTime file
                        -- getMofificationTime may fail
 
                        -- getMofificationTime may fail
 
-       obj_timestamp <- modificationTimeIfExists (ml_obj_file location)
+        -- when the user asks to load a source file by name, we only
+        -- use an object file if -fobject-code is on.  See #1205.
+       obj_timestamp <-
+            if isObjectTarget (hscTarget (hsc_dflags hsc_env)) 
+               || obj_allowed -- bug #1205
+                then liftIO $ modificationTimeIfExists (ml_obj_file location)
+                else return Nothing
 
         return (ModSummary { ms_mod = mod, ms_hsc_src = HsSrcFile,
                             ms_location = location,
 
         return (ModSummary { ms_mod = mod, ms_hsc_src = HsSrcFile,
                             ms_location = location,
@@ -1646,15 +2120,18 @@ findSummaryBySourceFile summaries file
 
 -- Summarise a module, and pick up source and timestamp.
 summariseModule
 
 -- Summarise a module, and pick up source and timestamp.
 summariseModule
-         :: HscEnv
+         :: GhcMonad m =>
+             HscEnv
          -> NodeMap ModSummary -- Map of old summaries
          -> IsBootInterface    -- True <=> a {-# SOURCE #-} import
          -> Located ModuleName -- Imported module to be summarised
          -> NodeMap ModSummary -- Map of old summaries
          -> IsBootInterface    -- True <=> a {-# SOURCE #-} import
          -> Located ModuleName -- Imported module to be summarised
+          -> Bool               -- object code allowed?
          -> Maybe (StringBuffer, ClockTime)
          -> [ModuleName]               -- Modules to exclude
          -> Maybe (StringBuffer, ClockTime)
          -> [ModuleName]               -- Modules to exclude
-         -> IO (Maybe ModSummary)      -- Its new summary
+         -> m (Maybe ModSummary)       -- Its new summary
 
 
-summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) maybe_buf excl_mods
+summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) 
+                obj_allowed maybe_buf excl_mods
   | wanted_mod `elem` excl_mods
   = return Nothing
 
   | wanted_mod `elem` excl_mods
   = return Nothing
 
@@ -1670,11 +2147,11 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) maybe_buf exc
        case maybe_buf of
           Just (_,t) -> check_timestamp old_summary location src_fn t
           Nothing    -> do
        case maybe_buf of
           Just (_,t) -> check_timestamp old_summary location src_fn t
           Nothing    -> do
-               m <- System.IO.Error.try (getModificationTime src_fn)
+               m <- liftIO $ System.IO.Error.try (getModificationTime src_fn)
                case m of
                   Right t -> check_timestamp old_summary location src_fn t
                   Left e | isDoesNotExistError e -> find_it
                case m of
                   Right t -> check_timestamp old_summary location src_fn t
                   Left e | isDoesNotExistError e -> find_it
-                         | otherwise             -> ioError e
+                         | otherwise             -> liftIO $ ioError e
 
   | otherwise  = find_it
   where
 
   | otherwise  = find_it
   where
@@ -1685,7 +2162,11 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) maybe_buf exc
     check_timestamp old_summary location src_fn src_timestamp
        | ms_hs_date old_summary == src_timestamp = do
                -- update the object-file timestamp
     check_timestamp old_summary location src_fn src_timestamp
        | ms_hs_date old_summary == src_timestamp = do
                -- update the object-file timestamp
-               obj_timestamp <- getObjTimestamp location is_boot
+                obj_timestamp <- liftIO $
+                    if isObjectTarget (hscTarget (hsc_dflags hsc_env))
+                       || obj_allowed -- bug #1205
+                       then getObjTimestamp location is_boot
+                       else return Nothing
                return (Just old_summary{ ms_obj_date = obj_timestamp })
        | otherwise = 
                -- source changed: re-summarise.
                return (Just old_summary{ ms_obj_date = obj_timestamp })
        | otherwise = 
                -- source changed: re-summarise.
@@ -1696,8 +2177,8 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) maybe_buf exc
        -- previously a package module, it may have now appeared on the
        -- search path, so we want to consider it to be a home module.  If
        -- the module was previously a home module, it may have moved.
        -- previously a package module, it may have now appeared on the
        -- search path, so we want to consider it to be a home module.  If
        -- the module was previously a home module, it may have moved.
-       uncacheModule hsc_env wanted_mod
-       found <- findImportedModule hsc_env wanted_mod Nothing
+       liftIO $ uncacheModule hsc_env wanted_mod
+       found <- liftIO $ findImportedModule hsc_env wanted_mod Nothing
        case found of
             Found location mod 
                | isJust (ml_hs_file location) ->
        case found of
             Found location mod 
                | isJust (ml_hs_file location) ->
@@ -1707,9 +2188,8 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) maybe_buf exc
                        -- Drop external-pkg
                        ASSERT(modulePackageId mod /= thisPackage dflags)
                        return Nothing
                        -- Drop external-pkg
                        ASSERT(modulePackageId mod /= thisPackage dflags)
                        return Nothing
-               where
                        
                        
-            err -> noModError dflags loc wanted_mod err
+            err -> liftIO $ noModError dflags loc wanted_mod err
                        -- Not found
 
     just_found location mod = do
                        -- Not found
 
     just_found location mod = do
@@ -1721,7 +2201,7 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) maybe_buf exc
 
                -- Check that it exists
                -- It might have been deleted since the Finder last found it
 
                -- Check that it exists
                -- It might have been deleted since the Finder last found it
-       maybe_t <- modificationTimeIfExists src_fn
+       maybe_t <- liftIO $ modificationTimeIfExists src_fn
        case maybe_t of
          Nothing -> noHsFileErr loc src_fn
          Just t  -> new_summary location' mod src_fn t
        case maybe_t of
          Nothing -> noHsFileErr loc src_fn
          Just t  -> new_summary location' mod src_fn t
@@ -1731,27 +2211,32 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) maybe_buf exc
       = do
        -- Preprocess the source file and get its imports
        -- The dflags' contains the OPTIONS pragmas
       = do
        -- Preprocess the source file and get its imports
        -- The dflags' contains the OPTIONS pragmas
-       (dflags', hspp_fn, buf) <- preprocessFile dflags src_fn Nothing maybe_buf
+       (dflags', hspp_fn, buf) <- preprocessFile hsc_env src_fn Nothing maybe_buf
         (srcimps, the_imps, L mod_loc mod_name) <- getImports dflags' buf hspp_fn src_fn
 
        when (mod_name /= wanted_mod) $
         (srcimps, the_imps, L mod_loc mod_name) <- getImports dflags' buf hspp_fn src_fn
 
        when (mod_name /= wanted_mod) $
-               throwDyn $ mkPlainErrMsg mod_loc $ 
-                             text "file name does not match module name"
-                             <+> quotes (ppr mod_name)
+               throwOneError $ mkPlainErrMsg mod_loc $ 
+                             text "File name does not match module name:" 
+                             $$ text "Saw:" <+> quotes (ppr mod_name)
+                              $$ text "Expected:" <+> quotes (ppr wanted_mod)
 
                -- Find the object timestamp, and return the summary
 
                -- Find the object timestamp, and return the summary
-       obj_timestamp <- getObjTimestamp location is_boot
-
-       return (Just ( ModSummary { ms_mod       = mod, 
-                                   ms_hsc_src   = hsc_src,
-                                   ms_location  = location,
-                                   ms_hspp_file = hspp_fn,
-                                    ms_hspp_opts = dflags',
-                                   ms_hspp_buf  = Just buf,
-                                   ms_srcimps   = srcimps,
-                                   ms_imps      = the_imps,
-                                   ms_hs_date   = src_timestamp,
-                                   ms_obj_date  = obj_timestamp }))
+       obj_timestamp <- liftIO $
+           if isObjectTarget (hscTarget (hsc_dflags hsc_env))
+              || obj_allowed -- bug #1205
+              then getObjTimestamp location is_boot
+              else return Nothing
+
+       return (Just (ModSummary { ms_mod       = mod,
+                             ms_hsc_src   = hsc_src,
+                             ms_location  = location,
+                             ms_hspp_file = hspp_fn,
+                              ms_hspp_opts = dflags',
+                             ms_hspp_buf  = Just buf,
+                             ms_srcimps   = srcimps,
+                             ms_imps      = the_imps,
+                             ms_hs_date   = src_timestamp,
+                             ms_obj_date  = obj_timestamp }))
 
 
 getObjTimestamp :: ModLocation -> Bool -> IO (Maybe ClockTime)
 
 
 getObjTimestamp :: ModLocation -> Bool -> IO (Maybe ClockTime)
@@ -1760,22 +2245,29 @@ getObjTimestamp location is_boot
               else modificationTimeIfExists (ml_obj_file location)
 
 
               else modificationTimeIfExists (ml_obj_file location)
 
 
-preprocessFile :: DynFlags -> FilePath -> Maybe Phase -> Maybe (StringBuffer,ClockTime)
-  -> IO (DynFlags, FilePath, StringBuffer)
-preprocessFile dflags src_fn mb_phase Nothing
+preprocessFile :: GhcMonad m =>
+                  HscEnv
+               -> FilePath
+               -> Maybe Phase -- ^ Starting phase
+               -> Maybe (StringBuffer,ClockTime)
+               -> m (DynFlags, FilePath, StringBuffer)
+preprocessFile hsc_env src_fn mb_phase Nothing
   = do
   = do
-       (dflags', hspp_fn) <- preprocess dflags (src_fn, mb_phase)
-       buf <- hGetStringBuffer hspp_fn
+       (dflags', hspp_fn) <- preprocess hsc_env (src_fn, mb_phase)
+       buf <- liftIO $ hGetStringBuffer hspp_fn
        return (dflags', hspp_fn, buf)
 
        return (dflags', hspp_fn, buf)
 
-preprocessFile dflags src_fn mb_phase (Just (buf, _time))
+preprocessFile hsc_env src_fn mb_phase (Just (buf, _time))
   = do
   = do
+        let dflags = hsc_dflags hsc_env
        -- case we bypass the preprocessing stage?
        let 
        -- case we bypass the preprocessing stage?
        let 
-           local_opts = getOptions buf src_fn
+           local_opts = getOptions dflags buf src_fn
        --
        --
-       (dflags', _errs) <- parseDynamicFlags dflags (map unLoc local_opts)
-        -- XXX: shouldn't we be reporting the errors?
+       (dflags', leftovers, warns)
+            <- parseDynamicNoPackageFlags dflags local_opts
+        checkProcessArgsResult leftovers
+        handleFlagWarnings dflags' warns
 
        let
            needs_preprocessing
 
        let
            needs_preprocessing
@@ -1799,21 +2291,21 @@ preprocessFile dflags src_fn mb_phase (Just (buf, _time))
 noModError :: DynFlags -> SrcSpan -> ModuleName -> FindResult -> IO ab
 -- ToDo: we don't have a proper line number for this error
 noModError dflags loc wanted_mod err
 noModError :: DynFlags -> SrcSpan -> ModuleName -> FindResult -> IO ab
 -- ToDo: we don't have a proper line number for this error
 noModError dflags loc wanted_mod err
-  = throwDyn $ mkPlainErrMsg loc $ cannotFindModule dflags wanted_mod err
+  = throwOneError $ mkPlainErrMsg loc $ cannotFindModule dflags wanted_mod err
                                
                                
-noHsFileErr :: SrcSpan -> String -> a
+noHsFileErr :: GhcMonad m => SrcSpan -> String -> m a
 noHsFileErr loc path
 noHsFileErr loc path
-  = throwDyn $ mkPlainErrMsg loc $ text "Can't find" <+> text path
+  = throwOneError $ mkPlainErrMsg loc $ text "Can't find" <+> text path
  
  
-packageModErr :: ModuleName -> a
+packageModErr :: GhcMonad m => ModuleName -> m a
 packageModErr mod
 packageModErr mod
-  = throwDyn $ mkPlainErrMsg noSrcSpan $
+  = throwOneError $ mkPlainErrMsg noSrcSpan $
        text "module" <+> quotes (ppr mod) <+> text "is a package module"
 
 multiRootsErr :: [ModSummary] -> IO ()
 multiRootsErr [] = panic "multiRootsErr"
 multiRootsErr summs@(summ1:_)
        text "module" <+> quotes (ppr mod) <+> text "is a package module"
 
 multiRootsErr :: [ModSummary] -> IO ()
 multiRootsErr [] = panic "multiRootsErr"
 multiRootsErr summs@(summ1:_)
-  = throwDyn $ mkPlainErrMsg noSrcSpan $
+  = throwOneError $ mkPlainErrMsg noSrcSpan $
        text "module" <+> quotes (ppr mod) <+> 
        text "is defined in multiple files:" <+>
        sep (map text files)
        text "module" <+> quotes (ppr mod) <+> 
        text "is defined in multiple files:" <+>
        sep (map text files)
@@ -1823,51 +2315,68 @@ multiRootsErr summs@(summ1:_)
 
 cyclicModuleErr :: [ModSummary] -> SDoc
 cyclicModuleErr ms
 
 cyclicModuleErr :: [ModSummary] -> SDoc
 cyclicModuleErr ms
-  = hang (ptext SLIT("Module imports form a cycle for modules:"))
+  = hang (ptext (sLit "Module imports form a cycle for modules:"))
        2 (vcat (map show_one ms))
   where
        2 (vcat (map show_one ms))
   where
-    show_one ms = sep [ show_mod (ms_hsc_src ms) (ms_mod ms),
-                       nest 2 $ ptext SLIT("imports:") <+> 
-                                  (pp_imps HsBootFile (ms_srcimps ms)
-                                  $$ pp_imps HsSrcFile  (ms_imps ms))]
+    mods_in_cycle = map ms_mod_name ms
+    imp_modname = unLoc . ideclName . unLoc
+    just_in_cycle = filter ((`elem` mods_in_cycle) . imp_modname)
+
+    show_one ms = 
+           vcat [ show_mod (ms_hsc_src ms) (ms_mod_name ms) <+>
+                  maybe empty (parens . text) (ml_hs_file (ms_location ms)),
+                  nest 2 $ ptext (sLit "imports:") <+> vcat [
+                     pp_imps HsBootFile (just_in_cycle $ ms_srcimps ms),
+                     pp_imps HsSrcFile  (just_in_cycle $ ms_imps ms) ]
+                ]
     show_mod hsc_src mod = ppr mod <> text (hscSourceString hsc_src)
     show_mod hsc_src mod = ppr mod <> text (hscSourceString hsc_src)
-    pp_imps src mods = fsep (map (show_mod src) mods)
+    pp_imps src imps = fsep (map (show_mod src . unLoc . ideclName . unLoc) imps)
 
 
 -- | Inform GHC that the working directory has changed.  GHC will flush
 -- its cache of module locations, since it may no longer be valid.
 
 
 -- | Inform GHC that the working directory has changed.  GHC will flush
 -- its cache of module locations, since it may no longer be valid.
--- Note: if you change the working directory, you should also unload
--- the current program (set targets to empty, followed by load).
-workingDirectoryChanged :: Session -> IO ()
-workingDirectoryChanged s = withSession s $ flushFinderCaches
+-- 
+-- Note: Before changing the working directory make sure all threads running
+-- in the same session have stopped.  If you change the working directory,
+-- you should also unload the current program (set targets to empty,
+-- followed by load).
+workingDirectoryChanged :: GhcMonad m => m ()
+workingDirectoryChanged = withSession $ (liftIO . flushFinderCaches)
 
 -- -----------------------------------------------------------------------------
 -- inspecting the session
 
 -- | Get the module dependency graph.
 
 -- -----------------------------------------------------------------------------
 -- inspecting the session
 
 -- | Get the module dependency graph.
-getModuleGraph :: Session -> IO ModuleGraph -- ToDo: DiGraph ModSummary
-getModuleGraph s = withSession s (return . hsc_mod_graph)
+getModuleGraph :: GhcMonad m => m ModuleGraph -- ToDo: DiGraph ModSummary
+getModuleGraph = liftM hsc_mod_graph getSession
 
 
-isLoaded :: Session -> ModuleName -> IO Bool
-isLoaded s m = withSession s $ \hsc_env ->
+-- | Determines whether a set of modules requires Template Haskell.
+--
+-- Note that if the session's 'DynFlags' enabled Template Haskell when
+-- 'depanal' was called, then each module in the returned module graph will
+-- have Template Haskell enabled whether it is actually needed or not.
+needsTemplateHaskell :: ModuleGraph -> Bool
+needsTemplateHaskell ms =
+    any (dopt Opt_TemplateHaskell . ms_hspp_opts) ms
+
+-- | Return @True@ <==> module is loaded.
+isLoaded :: GhcMonad m => ModuleName -> m Bool
+isLoaded m = withSession $ \hsc_env ->
   return $! isJust (lookupUFM (hsc_HPT hsc_env) m)
 
   return $! isJust (lookupUFM (hsc_HPT hsc_env) m)
 
-getBindings :: Session -> IO [TyThing]
-getBindings s = withSession s $ \hsc_env ->
+-- | Return the bindings for the current interactive session.
+getBindings :: GhcMonad m => m [TyThing]
+getBindings = withSession $ \hsc_env ->
    -- we have to implement the shadowing behaviour of ic_tmp_ids here
    -- (see InteractiveContext) and the quickest way is to use an OccEnv.
    let 
    -- we have to implement the shadowing behaviour of ic_tmp_ids here
    -- (see InteractiveContext) and the quickest way is to use an OccEnv.
    let 
-       tmp_ids = ic_tmp_ids (hsc_IC hsc_env)
-       filtered = foldr f (const []) tmp_ids emptyUniqSet
-       f id rest set 
-           | uniq `elementOfUniqSet` set = rest set
-           | otherwise  = AnId id : rest (addOneToUniqSet set uniq)
-           where uniq = getUnique (nameOccName (idName id))
+       occ_env = mkOccEnv [ (nameOccName (idName id), AnId id) 
+                          | id <- ic_tmp_ids (hsc_IC hsc_env) ]
    in
    in
-   return filtered
+   return (occEnvElts occ_env)
 
 
-getPrintUnqual :: Session -> IO PrintUnqualified
-getPrintUnqual s = withSession s $ \hsc_env ->
+getPrintUnqual :: GhcMonad m => m PrintUnqualified
+getPrintUnqual = withSession $ \hsc_env ->
   return (icPrintUnqual (hsc_dflags hsc_env) (hsc_IC hsc_env))
 
 -- | Container for information about a 'Module'.
   return (icPrintUnqual (hsc_dflags hsc_env) (hsc_IC hsc_env))
 
 -- | Container for information about a 'Module'.
@@ -1885,15 +2394,15 @@ data ModuleInfo = ModuleInfo {
        -- to package modules too.
 
 -- | Request information about a loaded 'Module'
        -- to package modules too.
 
 -- | Request information about a loaded 'Module'
-getModuleInfo :: Session -> Module -> IO (Maybe ModuleInfo)
-getModuleInfo s mdl = withSession s $ \hsc_env -> do
+getModuleInfo :: GhcMonad m => Module -> m (Maybe ModuleInfo)  -- XXX: Maybe X
+getModuleInfo mdl = withSession $ \hsc_env -> do
   let mg = hsc_mod_graph hsc_env
   if mdl `elem` map ms_mod mg
   let mg = hsc_mod_graph hsc_env
   if mdl `elem` map ms_mod mg
-       then getHomeModuleInfo hsc_env (moduleName mdl)
+       then liftIO $ getHomeModuleInfo hsc_env (moduleName mdl)
        else do
   {- if isHomeModule (hsc_dflags hsc_env) mdl
        then return Nothing
        else do
   {- if isHomeModule (hsc_dflags hsc_env) mdl
        then return Nothing
-       else -} getPackageModuleInfo hsc_env mdl
+       else -} liftIO $ getPackageModuleInfo hsc_env mdl
    -- getPackageModuleInfo will attempt to find the interface, so
    -- we don't want to call it for a home module, just in case there
    -- was a problem loading the module and the interface doesn't
    -- getPackageModuleInfo will attempt to find the interface, so
    -- we don't want to call it for a home module, just in case there
    -- was a problem loading the module and the interface doesn't
@@ -1961,16 +2470,20 @@ modInfoInstances = minf_instances
 modInfoIsExportedName :: ModuleInfo -> Name -> Bool
 modInfoIsExportedName minf name = elemNameSet name (minf_exports minf)
 
 modInfoIsExportedName :: ModuleInfo -> Name -> Bool
 modInfoIsExportedName minf name = elemNameSet name (minf_exports minf)
 
-mkPrintUnqualifiedForModule :: Session -> ModuleInfo -> IO (Maybe PrintUnqualified)
-mkPrintUnqualifiedForModule s minf = withSession s $ \hsc_env -> do
+mkPrintUnqualifiedForModule :: GhcMonad m =>
+                               ModuleInfo
+                            -> m (Maybe PrintUnqualified) -- XXX: returns a Maybe X
+mkPrintUnqualifiedForModule minf = withSession $ \hsc_env -> do
   return (fmap (mkPrintUnqualified (hsc_dflags hsc_env)) (minf_rdr_env minf))
 
   return (fmap (mkPrintUnqualified (hsc_dflags hsc_env)) (minf_rdr_env minf))
 
-modInfoLookupName :: Session -> ModuleInfo -> Name -> IO (Maybe TyThing)
-modInfoLookupName s minf name = withSession s $ \hsc_env -> do
+modInfoLookupName :: GhcMonad m =>
+                     ModuleInfo -> Name
+                  -> m (Maybe TyThing) -- XXX: returns a Maybe X
+modInfoLookupName minf name = withSession $ \hsc_env -> do
    case lookupTypeEnv (minf_type_env minf) name of
      Just tyThing -> return (Just tyThing)
      Nothing      -> do
    case lookupTypeEnv (minf_type_env minf) name of
      Just tyThing -> return (Just tyThing)
      Nothing      -> do
-       eps <- readIORef (hsc_EPS hsc_env)
+       eps <- liftIO $ readIORef (hsc_EPS hsc_env)
        return $! lookupType (hsc_dflags hsc_env) 
                            (hsc_HPT hsc_env) (eps_PTE eps) name
 
        return $! lookupType (hsc_dflags hsc_env) 
                            (hsc_HPT hsc_env) (eps_PTE eps) name
 
@@ -1987,11 +2500,37 @@ isDictonaryId id
 -- visible module.  Unlike 'lookupName', lookupGlobalName does not use
 -- the interactive context, and therefore does not require a preceding
 -- 'setContext'.
 -- visible module.  Unlike 'lookupName', lookupGlobalName does not use
 -- the interactive context, and therefore does not require a preceding
 -- 'setContext'.
-lookupGlobalName :: Session -> Name -> IO (Maybe TyThing)
-lookupGlobalName s name = withSession s $ \hsc_env -> do
-   eps <- readIORef (hsc_EPS hsc_env)
-   return $! lookupType (hsc_dflags hsc_env) 
-                       (hsc_HPT hsc_env) (eps_PTE eps) name
+lookupGlobalName :: GhcMonad m => Name -> m (Maybe TyThing)
+lookupGlobalName name = withSession $ \hsc_env -> do
+   liftIO $ lookupTypeHscEnv hsc_env name
+
+findGlobalAnns :: (GhcMonad m, Typeable a) => ([Word8] -> a) -> AnnTarget Name -> m [a]
+findGlobalAnns deserialize target = withSession $ \hsc_env -> do
+    ann_env <- liftIO $ prepareAnnotations hsc_env Nothing
+    return (findAnns deserialize ann_env target)
+
+#ifdef GHCI
+-- | get the GlobalRdrEnv for a session
+getGRE :: GhcMonad m => m GlobalRdrEnv
+getGRE = withSession $ \hsc_env-> return $ ic_rn_gbl_env (hsc_IC hsc_env)
+#endif
+
+-- -----------------------------------------------------------------------------
+
+-- | Return all /external/ modules available in the package database.
+-- Modules from the current session (i.e., from the 'HomePackageTable') are
+-- not included.
+packageDbModules :: GhcMonad m =>
+                    Bool  -- ^ Only consider exposed packages.
+                 -> m [Module]
+packageDbModules only_exposed = do
+   dflags <- getSessionDynFlags
+   let pkgs = UFM.eltsUFM (pkgIdMap (pkgState dflags))
+   return $
+     [ mkModule pid modname | p <- pkgs
+                            , not only_exposed || exposed p
+                            , let pid = packageConfigId p
+                            , modname <- exposedModules p ]
 
 -- -----------------------------------------------------------------------------
 -- Misc exported utils
 
 -- -----------------------------------------------------------------------------
 -- Misc exported utils
@@ -2019,52 +2558,158 @@ pprParenSymName a = parenSymOcc (getOccName a) (ppr (getName a))
 -- :browse will use either lm_toplev or inspect lm_interface, depending
 -- on whether the module is interpreted or not.
 
 -- :browse will use either lm_toplev or inspect lm_interface, depending
 -- on whether the module is interpreted or not.
 
--- This is for reconstructing refactored source code
--- Calls the lexer repeatedly.
--- ToDo: add comment tokens to token stream
-getTokenStream :: Session -> Module -> IO [Located Token]
 #endif
 
 #endif
 
+-- Extract the filename, stringbuffer content and dynflags associed to a module
+--
+-- XXX: Explain pre-conditions
+getModuleSourceAndFlags :: GhcMonad m => Module -> m (String, StringBuffer, DynFlags)
+getModuleSourceAndFlags mod = do
+  m <- getModSummary (moduleName mod)
+  case ml_hs_file $ ms_location m of
+    Nothing -> throw $ mkApiErr (text "No source available for module " <+> ppr mod)
+    Just sourceFile -> do
+        source <- liftIO $ hGetStringBuffer sourceFile
+        return (sourceFile, source, ms_hspp_opts m)
+
+
+-- | Return module source as token stream, including comments.
+--
+-- The module must be in the module graph and its source must be available.
+-- Throws a 'HscTypes.SourceError' on parse error.
+getTokenStream :: GhcMonad m => Module -> m [Located Token]
+getTokenStream mod = do
+  (sourceFile, source, flags) <- getModuleSourceAndFlags mod
+  let startLoc = mkSrcLoc (mkFastString sourceFile) 1 1
+  case lexTokenStream source startLoc flags of
+    POk _ ts  -> return ts
+    PFailed span err -> throw $ mkSrcErr (unitBag $ mkPlainErrMsg span err)
+
+-- | Give even more information on the source than 'getTokenStream'
+-- This function allows reconstructing the source completely with
+-- 'showRichTokenStream'.
+getRichTokenStream :: GhcMonad m => Module -> m [(Located Token, String)]
+getRichTokenStream mod = do
+  (sourceFile, source, flags) <- getModuleSourceAndFlags mod
+  let startLoc = mkSrcLoc (mkFastString sourceFile) 1 1
+  case lexTokenStream source startLoc flags of
+    POk _ ts -> return $ addSourceToTokens startLoc source ts
+    PFailed span err -> throw $ mkSrcErr (unitBag $ mkPlainErrMsg span err)
+
+-- | Given a source location and a StringBuffer corresponding to this
+-- location, return a rich token stream with the source associated to the
+-- tokens.
+addSourceToTokens :: SrcLoc -> StringBuffer -> [Located Token]
+                  -> [(Located Token, String)]
+addSourceToTokens _ _ [] = []
+addSourceToTokens loc buf (t@(L span _) : ts)
+    | not (isGoodSrcSpan span) = (t,"") : addSourceToTokens loc buf ts
+    | otherwise = (t,str) : addSourceToTokens newLoc newBuf ts
+    where
+      (newLoc, newBuf, str) = go "" loc buf
+      start = srcSpanStart span
+      end = srcSpanEnd span
+      go acc loc buf | loc < start = go acc nLoc nBuf
+                     | start <= loc && loc < end = go (ch:acc) nLoc nBuf
+                     | otherwise = (loc, buf, reverse acc)
+          where (ch, nBuf) = nextChar buf
+                nLoc = advanceSrcLoc loc ch
+
+
+-- | Take a rich token stream such as produced from 'getRichTokenStream' and
+-- return source code almost identical to the original code (except for
+-- insignificant whitespace.)
+showRichTokenStream :: [(Located Token, String)] -> String
+showRichTokenStream ts = go startLoc ts ""
+    where sourceFile = srcSpanFile (getLoc . fst . head $ ts)
+          startLoc = mkSrcLoc sourceFile 1 1
+          go _ [] = id
+          go loc ((L span _, str):ts)
+              | not (isGoodSrcSpan span) = go loc ts
+              | locLine == tokLine = ((replicate (tokCol - locCol) ' ') ++)
+                                     . (str ++)
+                                     . go tokEnd ts
+              | otherwise = ((replicate (tokLine - locLine) '\n') ++)
+                            . ((replicate tokCol ' ') ++)
+                            . (str ++)
+                            . go tokEnd ts
+              where (locLine, locCol) = (srcLocLine loc, srcLocCol loc)
+                    (tokLine, tokCol) = (srcSpanStartLine span, srcSpanStartCol span)
+                    tokEnd = srcSpanEnd span
+
 -- -----------------------------------------------------------------------------
 -- Interactive evaluation
 
 -- | Takes a 'ModuleName' and possibly a 'PackageId', and consults the
 -- filesystem and package database to find the corresponding 'Module', 
 -- using the algorithm that is used for an @import@ declaration.
 -- -----------------------------------------------------------------------------
 -- Interactive evaluation
 
 -- | Takes a 'ModuleName' and possibly a 'PackageId', and consults the
 -- filesystem and package database to find the corresponding 'Module', 
 -- using the algorithm that is used for an @import@ declaration.
-findModule :: Session -> ModuleName -> Maybe PackageId -> IO Module
-findModule s mod_name maybe_pkg = withSession s $ \hsc_env ->
-  let
-        dflags = hsc_dflags hsc_env
-        hpt    = hsc_HPT hsc_env
-        this_pkg = thisPackage dflags
-  in
-  case lookupUFM hpt mod_name of
-    Just mod_info -> return (mi_module (hm_iface mod_info))
-    _not_a_home_module -> do
-         res <- findImportedModule hsc_env mod_name maybe_pkg
-         case res of
-           Found _ m | modulePackageId m /= this_pkg -> return m
-                     | otherwise -> throwDyn (CmdLineError (showSDoc $
-                                       text "module" <+> pprModule m <+>
-                                       text "is not loaded"))
-           err -> let msg = cannotFindModule dflags mod_name err in
-                  throwDyn (CmdLineError (showSDoc msg))
+findModule :: GhcMonad m => ModuleName -> Maybe FastString -> m Module
+findModule mod_name maybe_pkg = withSession $ \hsc_env -> do
+  let 
+    dflags   = hsc_dflags hsc_env
+    this_pkg = thisPackage dflags
+  --
+  case maybe_pkg of
+    Just pkg | fsToPackageId pkg /= this_pkg && pkg /= fsLit "this" -> liftIO $ do
+      res <- findImportedModule hsc_env mod_name maybe_pkg
+      case res of
+        Found _ m -> return m
+        err       -> noModError dflags noSrcSpan mod_name err
+    _otherwise -> do
+      home <- lookupLoadedHomeModule mod_name
+      case home of
+        Just m  -> return m
+        Nothing -> liftIO $ do
+           res <- findImportedModule hsc_env mod_name maybe_pkg
+           case res of
+             Found loc m | modulePackageId m /= this_pkg -> return m
+                         | otherwise -> modNotLoadedError m loc
+             err -> noModError dflags noSrcSpan mod_name err
+
+modNotLoadedError :: Module -> ModLocation -> IO a
+modNotLoadedError m loc = ghcError $ CmdLineError $ showSDoc $
+   text "module is not loaded:" <+> 
+   quotes (ppr (moduleName m)) <+>
+   parens (text (expectJust "modNotLoadedError" (ml_hs_file loc)))
+
+-- | Like 'findModule', but differs slightly when the module refers to
+-- a source file, and the file has not been loaded via 'load'.  In
+-- this case, 'findModule' will throw an error (module not loaded),
+-- but 'lookupModule' will check to see whether the module can also be
+-- found in a package, and if so, that package 'Module' will be
+-- returned.  If not, the usual module-not-found error will be thrown.
+--
+lookupModule :: GhcMonad m => ModuleName -> Maybe FastString -> m Module
+lookupModule mod_name (Just pkg) = findModule mod_name (Just pkg)
+lookupModule mod_name Nothing = withSession $ \hsc_env -> do
+  home <- lookupLoadedHomeModule mod_name
+  case home of
+    Just m  -> return m
+    Nothing -> liftIO $ do
+      res <- findExposedPackageModule hsc_env mod_name Nothing
+      case res of
+        Found _ m -> return m
+       err       -> noModError (hsc_dflags hsc_env) noSrcSpan mod_name err
+
+lookupLoadedHomeModule  :: GhcMonad m => ModuleName -> m (Maybe Module)
+lookupLoadedHomeModule mod_name = withSession $ \hsc_env ->
+  case lookupUFM (hsc_HPT hsc_env) mod_name of
+    Just mod_info      -> return (Just (mi_module (hm_iface mod_info)))
+    _not_a_home_module -> return Nothing
 
 #ifdef GHCI
 
 #ifdef GHCI
-getHistorySpan :: Session -> History -> IO SrcSpan
-getHistorySpan sess h = withSession sess $ \hsc_env -> 
+getHistorySpan :: GhcMonad m => History -> m SrcSpan
+getHistorySpan h = withSession $ \hsc_env ->
                           return$ InteractiveEval.getHistorySpan hsc_env h
 
                           return$ InteractiveEval.getHistorySpan hsc_env h
 
-obtainTerm :: Session -> Bool -> Id -> IO Term
-obtainTerm sess force id = withSession sess $ \hsc_env ->
-                            InteractiveEval.obtainTerm hsc_env force id
-
-obtainTerm1 :: Session -> Bool -> Maybe Type -> a -> IO Term
-obtainTerm1 sess force mb_ty a = withSession sess $ \hsc_env ->
-                               InteractiveEval.obtainTerm1 hsc_env force mb_ty a
+obtainTermFromVal :: GhcMonad m => Int ->  Bool -> Type -> a -> m Term
+obtainTermFromVal bound force ty a =
+    withSession $ \hsc_env ->
+      liftIO $ InteractiveEval.obtainTermFromVal hsc_env bound force ty a
 
 
-obtainTermB :: Session -> Int -> Bool -> Id -> IO Term
-obtainTermB sess bound force id = withSession sess $ \hsc_env ->
-                            InteractiveEval.obtainTermB hsc_env bound force id
+obtainTermFromId :: GhcMonad m => Int -> Bool -> Id -> m Term
+obtainTermFromId bound force id =
+    withSession $ \hsc_env ->
+      liftIO $ InteractiveEval.obtainTermFromId hsc_env bound force id
 
 #endif
 
 #endif