Make mkPState and pragState take their arguments in the same order
[ghc-hetmet.git] / compiler / main / HscMain.lhs
index f054d25..933503e 100644 (file)
@@ -1,25 +1,32 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1993-2000
 %
-
-\section[GHC_Main]{Main driver for Glasgow Haskell compiler}
-
 \begin{code}
+-- | Main driver for the compiling plain Haskell source code.
+--
+-- This module implements compilation of a Haskell-only source file.  It is
+-- /not/ concerned with preprocessing of source files; this is handled in
+-- "DriverPipeline".
+--
 module HscMain
     ( newHscEnv, hscCmmFile
     , hscParseIdentifier
     , hscSimplify
     , hscNormalIface, hscWriteIface, hscGenHardCode
 #ifdef GHCI
-    , hscStmt, hscTcExpr, hscKcType
+    , hscStmt, hscTcExpr, hscImport, hscKcType
     , compileExpr
 #endif
+    , HsCompiler(..)
+    , hscOneShotCompiler, hscNothingCompiler
+    , hscInteractiveCompiler, hscBatchCompiler
     , hscCompileOneShot     -- :: Compiler HscStatus
     , hscCompileBatch       -- :: Compiler (HscStatus, ModIface, ModDetails)
     , hscCompileNothing     -- :: Compiler (HscStatus, ModIface, ModDetails)
     , hscCompileInteractive -- :: Compiler (InteractiveStatus, ModIface, ModDetails)
+    , hscCheckRecompBackend
     , HscStatus' (..)
-    , InteractiveStatus, NothingStatus, OneShotStatus, BatchStatus
+    , InteractiveStatus, HscStatus
 
     -- The new interface
     , hscParse
@@ -44,7 +51,7 @@ import PrelNames      ( iNTERACTIVE )
 import {- Kind parts of -} Type                ( Kind )
 import CoreLint                ( lintUnfolding )
 import DsMeta          ( templateHaskellNames )
-import SrcLoc          ( SrcSpan, noSrcLoc, interactiveSrcLoc, srcLocSpan, noSrcSpan )
+import SrcLoc          ( SrcSpan, noSrcLoc, interactiveSrcLoc, srcLocSpan, noSrcSpan, unLoc )
 import VarSet
 import VarEnv          ( emptyTidyEnv )
 #endif
@@ -102,14 +109,14 @@ import HscStats           ( ppSourceStats )
 import HscTypes
 import MkExternalCore  ( emitExternalCore )
 import FastString
-import LazyUniqFM              ( emptyUFM )
+import UniqFM          ( emptyUFM )
 import UniqSupply       ( initUs_ )
 import Bag             ( unitBag )
 import Exception
-import MonadUtils
+-- import MonadUtils
 
 import Control.Monad
-import System.IO
+-- import System.IO
 import Data.IORef
 \end{code}
 #include "HsVersions.h"
@@ -122,8 +129,8 @@ import Data.IORef
 %************************************************************************
 
 \begin{code}
-newHscEnv :: DynFlags -> IO HscEnv
-newHscEnv dflags
+newHscEnv :: GhcApiCallbacks -> DynFlags -> IO HscEnv
+newHscEnv callbacks dflags
   = do         { eps_var <- newIORef initExternalPackageState
        ; us      <- mkSplitUniqSupply 'r'
        ; nc_var  <- newIORef (initNameCache us knownKeyNames)
@@ -131,6 +138,7 @@ newHscEnv dflags
        ; mlc_var <- newIORef emptyModuleEnv
         ; optFuel <- initOptFuelState
        ; return (HscEnv { hsc_dflags = dflags,
+                           hsc_callbacks = callbacks,
                           hsc_targets = [],
                           hsc_mod_graph = [],
                           hsc_IC      = emptyInteractiveContext,
@@ -176,9 +184,9 @@ hscParse mod_summary = do
             Just b  -> return b
             Nothing -> liftIO $ hGetStringBuffer src_filename
 
-   let loc  = mkSrcLoc (mkFastString src_filename) 1 0
+   let loc  = mkSrcLoc (mkFastString src_filename) 1 1
 
-   case unP parseModule (mkPState buf loc dflags) of
+   case unP parseModule (mkPState dflags buf loc) of
      PFailed span err ->
          throwOneError (mkPlainErrMsg span err)
 
@@ -209,7 +217,7 @@ hscTypecheck mod_summary rdr_module = do
 -- exception/signal an error.
 type RenamedStuff = 
         (Maybe (HsGroup Name, [LImportDecl Name], Maybe [LIE Name],
-                Maybe (HsDoc Name), HaddockModInfo Name))
+                Maybe LHsDocString))
 
 -- | Rename and typecheck a module, additionally returning the renamed syntax
 hscTypecheckRename ::
@@ -222,12 +230,12 @@ hscTypecheckRename mod_summary rdr_module = do
           <- {-# SCC "Typecheck-Rename" #-}
              ioMsgMaybe $ tcRnModule hsc_env (ms_hsc_src mod_summary) True rdr_module
 
-    let rn_info = do decl <- tcg_rn_decls tc_result
-                     imports <- tcg_rn_imports tc_result
-                     let exports = tcg_rn_exports tc_result
-                     let doc = tcg_doc tc_result
-                    let hmi = tcg_hmi tc_result
-                     return (decl,imports,exports,doc,hmi)
+    let -- This 'do' is in the Maybe monad!
+        rn_info = do { decl <- tcg_rn_decls tc_result
+                     ; let imports = tcg_rn_imports tc_result
+                           exports = tcg_rn_exports tc_result
+                           doc_hdr  = tcg_doc_hdr tc_result
+                     ; return (decl,imports,exports,doc_hdr) }
 
     return (tc_result, rn_info)
 
@@ -308,17 +316,13 @@ data HscStatus' a
 -- functional dependencies, we have to parameterise the typeclass over the
 -- result type.  Therefore we need to artificially distinguish some types.  We
 -- do this by adding type tags which will simply be ignored by the caller.
-data HscOneShotTag = HscOneShotTag
-data HscNothingTag = HscNothingTag
-
-type OneShotStatus     = HscStatus' HscOneShotTag
-type BatchStatus       = HscStatus' ()
-type InteractiveStatus = HscStatus' (CompiledByteCode, ModBreaks)
-type NothingStatus     = HscStatus' HscNothingTag
+type HscStatus         = HscStatus' ()
+type InteractiveStatus = HscStatus' (Maybe (CompiledByteCode, ModBreaks))
+    -- INVARIANT: result is @Nothing@ <=> input was a boot file
 
-type OneShotResult = OneShotStatus
-type BatchResult   = (BatchStatus, ModIface, ModDetails)
-type NothingResult = (NothingStatus, ModIface, ModDetails)
+type OneShotResult     = HscStatus
+type BatchResult       = (HscStatus, ModIface, ModDetails)
+type NothingResult     = (HscStatus, ModIface, ModDetails)
 type InteractiveResult = (InteractiveStatus, ModIface, ModDetails)
 
 -- FIXME: The old interface and module index are only using in 'batch' and
@@ -331,36 +335,35 @@ type Compiler result =  GhcMonad m =>
                      -> Maybe (Int,Int)     -- Just (i,n) <=> module i of n (for msgs)
                      -> m result
 
-class HsCompiler a where
-  -- | The main interface.
-  hscCompile :: GhcMonad m =>
-                HscEnv -> ModSummary -> Bool
-             -> Maybe ModIface -> Maybe (Int, Int)
-             -> m a
+data HsCompiler a
+  = HsCompiler {
+    -- | Called when no recompilation is necessary.
+    hscNoRecomp :: GhcMonad m =>
+                   ModIface -> m a,
 
-  -- | Called when no recompilation is necessary.
-  hscNoRecomp :: GhcMonad m =>
-                 ModIface -> m a
+    -- | Called to recompile the module.
+    hscRecompile :: GhcMonad m =>
+                    ModSummary -> Maybe Fingerprint -> m a,
 
-  -- | Called to recompile the module.
-  hscRecompile :: GhcMonad m =>
-                  ModSummary -> Maybe Fingerprint -> m a
+    hscBackend :: GhcMonad m =>
+                  TcGblEnv -> ModSummary -> Maybe Fingerprint -> m a,
 
-  -- | Code generation for Boot modules.
-  hscGenBootOutput :: GhcMonad m =>
-                      TcGblEnv -> ModSummary -> Maybe Fingerprint -> m a
+    -- | Code generation for Boot modules.
+    hscGenBootOutput :: GhcMonad m =>
+                        TcGblEnv -> ModSummary -> Maybe Fingerprint -> m a,
 
-  -- | Code generation for normal modules.
-  hscGenOutput :: GhcMonad m =>
-                  ModGuts  -> ModSummary -> Maybe Fingerprint -> m a
+    -- | Code generation for normal modules.
+    hscGenOutput :: GhcMonad m =>
+                    ModGuts  -> ModSummary -> Maybe Fingerprint -> m a
+  }
 
-
-genericHscCompile :: (HsCompiler a, GhcMonad m) =>
-                     (Maybe (Int,Int) -> Bool -> ModSummary -> m ())
+genericHscCompile :: GhcMonad m =>
+                     HsCompiler a
+                  -> (Maybe (Int,Int) -> Bool -> ModSummary -> m ())
                   -> HscEnv -> ModSummary -> Bool
                   -> Maybe ModIface -> Maybe (Int, Int)
                   -> m a
-genericHscCompile hscMessage
+genericHscCompile compiler hscMessage
                   hsc_env mod_summary source_unchanged
                   mb_old_iface0 mb_mod_index =
    withTempSession (\_ -> hsc_env) $ do
@@ -375,147 +378,185 @@ genericHscCompile hscMessage
      case mb_checked_iface of
        Just iface | not recomp_reqd
            -> do hscMessage mb_mod_index False mod_summary
-                 hscNoRecomp iface
+                 hscNoRecomp compiler iface
        _otherwise
            -> do hscMessage mb_mod_index True mod_summary
-                 hscRecompile mod_summary mb_old_hash
+                 hscRecompile compiler mod_summary mb_old_hash
 
-genericHscRecompile :: (HsCompiler a, GhcMonad m) =>
-                       ModSummary -> Maybe Fingerprint
+hscCheckRecompBackend :: HsCompiler a -> TcGblEnv -> Compiler a
+hscCheckRecompBackend compiler tc_result 
+                   hsc_env mod_summary source_unchanged mb_old_iface _m_of_n =
+   withTempSession (\_ -> hsc_env) $ do
+     (recomp_reqd, mb_checked_iface)
+         <- {-# SCC "checkOldIface" #-}
+            liftIO $ checkOldIface hsc_env mod_summary
+                                   source_unchanged mb_old_iface
+
+     let mb_old_hash = fmap mi_iface_hash mb_checked_iface
+     case mb_checked_iface of
+       Just iface | not recomp_reqd
+           -> hscNoRecomp compiler iface{ mi_globals = Just (tcg_rdr_env tc_result) }
+       _otherwise
+           -> hscBackend compiler tc_result mod_summary mb_old_hash
+
+genericHscRecompile :: GhcMonad m =>
+                       HsCompiler a
+                    -> ModSummary -> Maybe Fingerprint
                     -> m a
-genericHscRecompile mod_summary mb_old_hash
+genericHscRecompile compiler mod_summary mb_old_hash
   | ExtCoreFile <- ms_hsc_src mod_summary =
       panic "GHC does not currently support reading External Core files"
   | otherwise = do
       tc_result <- hscFileFrontEnd mod_summary
-      case ms_hsc_src mod_summary of
-        HsBootFile ->
-            hscGenBootOutput tc_result mod_summary mb_old_hash
-        _other     -> do
-            guts <- hscDesugar mod_summary tc_result
-            hscGenOutput guts mod_summary mb_old_hash
+      hscBackend compiler tc_result mod_summary mb_old_hash
+
+genericHscBackend :: GhcMonad m =>
+                     HsCompiler a
+                  -> TcGblEnv -> ModSummary -> Maybe Fingerprint
+                  -> m a
+genericHscBackend compiler tc_result mod_summary mb_old_hash
+  | HsBootFile <- ms_hsc_src mod_summary =
+      hscGenBootOutput compiler tc_result mod_summary mb_old_hash
+  | otherwise = do
+      guts <- hscDesugar mod_summary tc_result
+      hscGenOutput compiler guts mod_summary mb_old_hash
 
 --------------------------------------------------------------
 -- Compilers
 --------------------------------------------------------------
 
-instance HsCompiler OneShotResult where
-
-  hscCompile hsc_env mod_summary src_changed mb_old_iface mb_i_of_n = do
-     -- One-shot mode needs a knot-tying mutable variable for interface files.
-     -- See TcRnTypes.TcGblEnv.tcg_type_env_var.
-    type_env_var <- liftIO $ newIORef emptyNameEnv
-    let 
-       mod = ms_mod mod_summary
-       hsc_env' = hsc_env{ hsc_type_env_var = Just (mod, type_env_var) }
-    ---
-    genericHscCompile oneShotMsg hsc_env' mod_summary src_changed
-                      mb_old_iface mb_i_of_n
-
-  hscNoRecomp _old_iface = do
-    withSession (liftIO . dumpIfaceStats)
-    return HscNoRecomp
-
-  hscRecompile = genericHscRecompile
-
-  hscGenBootOutput tc_result mod_summary mb_old_iface = do
-     (iface, changed, _) <- hscSimpleIface tc_result mb_old_iface
-     hscWriteIface iface changed mod_summary
-     return (HscRecomp False HscOneShotTag)
-
-  hscGenOutput guts0 mod_summary mb_old_iface = do
-     guts <- hscSimplify guts0
-     (iface, changed, _details, cgguts)
-         <- hscNormalIface guts mb_old_iface
-     hscWriteIface iface changed mod_summary
-     hasStub <- hscGenHardCode cgguts mod_summary
-     return (HscRecomp hasStub HscOneShotTag)
+hscOneShotCompiler :: HsCompiler OneShotResult
+hscOneShotCompiler =
+  HsCompiler {
+
+    hscNoRecomp = \_old_iface -> do
+      withSession (liftIO . dumpIfaceStats)
+      return HscNoRecomp
+
+  , hscRecompile = genericHscRecompile hscOneShotCompiler
+
+  , hscBackend = \ tc_result mod_summary mb_old_hash -> do
+       hsc_env <- getSession
+       case hscTarget (hsc_dflags hsc_env) of
+         HscNothing -> return (HscRecomp False ())
+         _otherw    -> genericHscBackend hscOneShotCompiler 
+                                         tc_result mod_summary mb_old_hash
+
+  , hscGenBootOutput = \tc_result mod_summary mb_old_iface -> do
+       (iface, changed, _) <- hscSimpleIface tc_result mb_old_iface
+       hscWriteIface iface changed mod_summary
+       return (HscRecomp False ())
+
+  , hscGenOutput = \guts0 mod_summary mb_old_iface -> do
+       guts <- hscSimplify guts0
+       (iface, changed, _details, cgguts)
+           <- hscNormalIface guts mb_old_iface
+       hscWriteIface iface changed mod_summary
+       hasStub <- hscGenHardCode cgguts mod_summary
+       return (HscRecomp hasStub ())
+  }
 
 -- Compile Haskell, boot and extCore in OneShot mode.
-hscCompileOneShot :: Compiler OneShotStatus
-hscCompileOneShot = hscCompile
+hscCompileOneShot :: Compiler OneShotResult
+hscCompileOneShot hsc_env mod_summary src_changed mb_old_iface mb_i_of_n = do
+       -- One-shot mode needs a knot-tying mutable variable for interface
+       -- files.  See TcRnTypes.TcGblEnv.tcg_type_env_var.
+      type_env_var <- liftIO $ newIORef emptyNameEnv
+      let
+         mod = ms_mod mod_summary
+         hsc_env' = hsc_env{ hsc_type_env_var = Just (mod, type_env_var) }
+      ---
+      genericHscCompile hscOneShotCompiler
+                        oneShotMsg hsc_env' mod_summary src_changed
+                        mb_old_iface mb_i_of_n
+
 
 --------------------------------------------------------------
 
-instance HsCompiler BatchResult where
+hscBatchCompiler :: HsCompiler BatchResult
+hscBatchCompiler =
+  HsCompiler {
 
-  hscCompile = genericHscCompile batchMsg
+    hscNoRecomp = \iface -> do
+       details <- genModDetails iface
+       return (HscNoRecomp, iface, details)
 
-  hscNoRecomp iface = do
-     details <- genModDetails iface
-     return (HscNoRecomp, iface, details)
+  , hscRecompile = genericHscRecompile hscBatchCompiler
 
-  hscRecompile = genericHscRecompile
+  , hscBackend = genericHscBackend hscBatchCompiler
 
-  hscGenBootOutput tc_result mod_summary mb_old_iface = do
-     (iface, changed, details)
-         <- hscSimpleIface tc_result mb_old_iface
-     hscWriteIface iface changed mod_summary
-     return (HscRecomp False (), iface, details)
+  , hscGenBootOutput = \tc_result mod_summary mb_old_iface -> do
+       (iface, changed, details)
+           <- hscSimpleIface tc_result mb_old_iface
+       hscWriteIface iface changed mod_summary
+       return (HscRecomp False (), iface, details)
 
-  hscGenOutput guts0 mod_summary mb_old_iface = do
-     guts <- hscSimplify guts0
-     (iface, changed, details, cgguts)
-         <- hscNormalIface guts mb_old_iface
-     hscWriteIface iface changed mod_summary
-     hasStub <- hscGenHardCode cgguts mod_summary
-     return (HscRecomp hasStub (), iface, details)
+  , hscGenOutput = \guts0 mod_summary mb_old_iface -> do
+       guts <- hscSimplify guts0
+       (iface, changed, details, cgguts)
+           <- hscNormalIface guts mb_old_iface
+       hscWriteIface iface changed mod_summary
+       hasStub <- hscGenHardCode cgguts mod_summary
+       return (HscRecomp hasStub (), iface, details)
+  }
 
 -- Compile Haskell, boot and extCore in batch mode.
-hscCompileBatch :: Compiler (BatchStatus, ModIface, ModDetails)
-hscCompileBatch = hscCompile
+hscCompileBatch :: Compiler (HscStatus, ModIface, ModDetails)
+hscCompileBatch = genericHscCompile hscBatchCompiler batchMsg
 
 --------------------------------------------------------------
 
-instance HsCompiler InteractiveResult where
-
-  hscCompile = genericHscCompile batchMsg
+hscInteractiveCompiler :: HsCompiler InteractiveResult
+hscInteractiveCompiler =
+  HsCompiler {
+    hscNoRecomp = \iface -> do
+       details <- genModDetails iface
+       return (HscNoRecomp, iface, details)
 
-  hscNoRecomp iface = do
-     details <- genModDetails iface
-     return (HscNoRecomp, iface, details)
+  , hscRecompile = genericHscRecompile hscInteractiveCompiler
 
-  hscRecompile = genericHscRecompile
+  , hscBackend = genericHscBackend hscInteractiveCompiler
 
-  hscGenBootOutput _ _ _ = panic "hscCompileInteractive: HsBootFile"
+  , hscGenBootOutput = \tc_result _mod_summary mb_old_iface -> do
+       (iface, _changed, details) <- hscSimpleIface tc_result mb_old_iface
+       return (HscRecomp False Nothing, iface, details)
 
-  hscGenOutput guts0 mod_summary mb_old_iface = do
-     guts <- hscSimplify guts0
-     (iface, _changed, details, cgguts)
-         <- hscNormalIface guts mb_old_iface
-     hscInteractive (iface, details, cgguts) mod_summary
+  , hscGenOutput = \guts0 mod_summary mb_old_iface -> do
+       guts <- hscSimplify guts0
+       (iface, _changed, details, cgguts)
+           <- hscNormalIface guts mb_old_iface
+       hscInteractive (iface, details, cgguts) mod_summary
+  }
 
 -- Compile Haskell, extCore to bytecode.
 hscCompileInteractive :: Compiler (InteractiveStatus, ModIface, ModDetails)
-hscCompileInteractive = hscCompile
+hscCompileInteractive = genericHscCompile hscInteractiveCompiler batchMsg
 
 --------------------------------------------------------------
 
-instance HsCompiler NothingResult where
+hscNothingCompiler :: HsCompiler NothingResult
+hscNothingCompiler =
+  HsCompiler {
+    hscNoRecomp = \iface -> do
+       details <- genModDetails iface
+       return (HscNoRecomp, iface, details)
 
-  hscCompile = genericHscCompile batchMsg
+  , hscRecompile = genericHscRecompile hscNothingCompiler
 
-  hscNoRecomp iface = do
-     details <- genModDetails iface
-     return (HscNoRecomp, iface, details)
+  , hscBackend = \tc_result _mod_summary mb_old_iface -> do
+       (iface, _changed, details) <- hscSimpleIface tc_result mb_old_iface
+       return (HscRecomp False (), iface, details)
 
-  hscRecompile mod_summary mb_old_hash
-    | ExtCoreFile <- ms_hsc_src mod_summary =
-        panic "hscCompileNothing: cannot do external core"
-    | otherwise = do
-        tc_result <- hscFileFrontEnd mod_summary
-        hscGenBootOutput tc_result mod_summary mb_old_hash
+  , hscGenBootOutput = \_ _ _ ->
+        panic "hscCompileNothing: hscGenBootOutput should not be called"
 
-  hscGenBootOutput tc_result _mod_summary mb_old_iface = do
-     (iface, _changed, details) <- hscSimpleIface tc_result mb_old_iface
-     return (HscRecomp False HscNothingTag, iface, details)
-
-  hscGenOutput _ _ _ =
-      panic "hscCompileNothing: hscGenOutput should not be called"
+  , hscGenOutput = \_ _ _ ->
+        panic "hscCompileNothing: hscGenOutput should not be called"
+  }
 
 -- Type-check Haskell and .hs-boot only (no external core)
-hscCompileNothing :: Compiler (NothingStatus, ModIface, ModDetails)
-hscCompileNothing = hscCompile
+hscCompileNothing :: Compiler (HscStatus, ModIface, ModDetails)
+hscCompileNothing = genericHscCompile hscNothingCompiler batchMsg
 
 --------------------------------------------------------------
 -- NoRecomp handlers
@@ -673,17 +714,18 @@ hscGenHardCode cgguts mod_summary
                  then do cmms <- tryNewCodeGen hsc_env this_mod data_tycons
                                  dir_imps cost_centre_info
                                  stg_binds hpc_info
-                         pprTrace "cmms" (ppr cmms) $ return cmms
+                         return cmms
                  else {-# SCC "CodeGen" #-}
                        codeGen dflags this_mod data_tycons
                                dir_imps cost_centre_info
                                stg_binds hpc_info
 
          --- Optionally run experimental Cmm transformations ---
-         cmms <- optionallyConvertAndOrCPS hsc_env cmms
+         -- cmms <- optionallyConvertAndOrCPS hsc_env cmms
                  -- unless certain dflags are on, the identity function
          ------------------  Code output -----------------------
          rawcmms <- cmmToRawCmm cmms
+         dumpIfSet_dyn dflags Opt_D_dump_cmmz "Raw Cmm" (ppr rawcmms)
          (_stub_h_exists, stub_c_exists)
              <- codeOutput dflags this_mod location foreign_stubs 
                 dependencies rawcmms
@@ -720,7 +762,8 @@ hscInteractive (iface, details, cgguts) mod_summary
          ------------------ Create f-x-dynamic C-side stuff ---
          (_istub_h_exists, istub_c_exists) 
              <- outputForeignStubs dflags this_mod location foreign_stubs
-         return (HscRecomp istub_c_exists (comp_bc, mod_breaks), iface, details)
+         return (HscRecomp istub_c_exists (Just (comp_bc, mod_breaks))
+                , iface, details)
 #else
 hscInteractive _ _ = panic "GHC not compiled with interpreter"
 #endif
@@ -734,7 +777,7 @@ hscCmmFile hsc_env filename = do
              parseCmmFile dflags filename
     cmms <- liftIO $ optionallyConvertAndOrCPS hsc_env [cmm]
     rawCmms <- liftIO $ cmmToRawCmm cmms
-    liftIO $ codeOutput dflags no_mod no_loc NoStubs [] rawCmms
+    _ <- liftIO $ codeOutput dflags no_mod no_loc NoStubs [] rawCmms
     return ()
   where
        no_mod = panic "hscCmmFile: no_mod"
@@ -750,11 +793,8 @@ tryNewCodeGen      :: HscEnv -> Module -> [TyCon] -> [Module]
                -> HpcInfo
                -> IO [Cmm]
 tryNewCodeGen hsc_env this_mod data_tycons imported_mods 
-             cost_centre_info stg_binds hpc_info
-  | not (dopt Opt_TryNewCodeGen (hsc_dflags hsc_env))
-  = return []
-  | otherwise
-  = do { let dflags = hsc_dflags hsc_env
+             cost_centre_info stg_binds hpc_info =
+  do   { let dflags = hsc_dflags hsc_env
         ; prog <- StgCmm.codeGen dflags this_mod data_tycons imported_mods 
                         cost_centre_info stg_binds hpc_info
        ; dumpIfSet_dyn dflags Opt_D_dump_cmmz "Cmm produced by new codegen" 
@@ -763,8 +803,8 @@ tryNewCodeGen hsc_env this_mod data_tycons imported_mods
        ; prog <- return $ map (runTx $ runCmmOpts cmmCfgOptsZ) prog
                -- Control flow optimisation
 
-        -- Note: Have to thread the module's SRT through all the procedures
-        -- because we greedily build it as we go.
+        -- We are building a single SRT for the entire module, so
+        -- we must thread it through all the procedures as we cps-convert them.
         ; us <- mkSplitUniqSupply 'S'
         ; let topSRT = initUs_ us emptySRT
        ; (topSRT, prog) <- foldM (protoCmmCPSZ hsc_env) (topSRT, []) prog
@@ -773,10 +813,8 @@ tryNewCodeGen hsc_env this_mod data_tycons imported_mods
        ; prog <- return $ map (runTx $ runCmmOpts cmmCfgOptsZ) (srtToData topSRT : prog)
                -- Control flow optimisation, again
 
-       ; dumpIfSet_dyn dflags Opt_D_dump_cmmz "Output Cmm" (pprCmms prog)
-
        ; let prog' = map cmmOfZgraph prog
-       ; dumpIfSet_dyn dflags Opt_D_dump_cmmz "Raw Cmm" (ppr prog')
+       ; dumpIfSet_dyn dflags Opt_D_dump_cmmz "Output Cmm" (ppr prog')
        ; return prog' }
 
 
@@ -815,7 +853,6 @@ testCmmConversion hsc_env cmm =
        let cvt = cmmOfZgraph $ cfopts $ chosen_graph
        dumpIfSet_dyn dflags Opt_D_dump_cvt_cmm "C-- post-conversion" (ppr cvt)
        return cvt
-       -- return cmm -- don't use the conversion
 
 myCoreToStg :: DynFlags -> Module -> [CoreBind]
             -> IO ( [(StgBinding,[(Id,[Id])])]  -- output program
@@ -894,6 +931,12 @@ hscStmt hsc_env stmt = do
 
        return $ Just (ids, hval)
 
+hscImport :: GhcMonad m => HscEnv -> String -> m (ImportDecl RdrName)
+hscImport hsc_env str = do
+    (L _ (HsModule{hsmodImports=is})) <- hscParseThing parseModule (hsc_dflags hsc_env) str
+    case is of
+        [i] -> return (unLoc i)
+        _ -> throwOneError (mkPlainErrMsg noSrcSpan (ptext (sLit "parse error in import declaration")))
 
 hscTcExpr      -- Typecheck an expression (but don't run it)
   :: GhcMonad m =>
@@ -951,9 +994,9 @@ hscParseThing parser dflags str
 
       buf <- liftIO $ stringToStringBuffer str
 
-      let loc  = mkSrcLoc (fsLit "<interactive>") 1 0
+      let loc  = mkSrcLoc (fsLit "<interactive>") 1 1
 
-      case unP parser (mkPState buf loc dflags) of
+      case unP parser (mkPState dflags buf loc) of
 
        PFailed span err -> do
           let msg = mkPlainErrMsg span err