[project @ 2005-04-04 11:55:11 by simonpj]
[ghc-hetmet.git] / ghc / compiler / main / HscMain.lhs
index 04a149e..83837ee 100644 (file)
@@ -6,11 +6,13 @@
 
 \begin{code}
 module HscMain ( 
-       HscResult(..), hscMain, newHscEnv, hscCmmFile, hscBufferFrontEnd
+       HscResult(..),
+       hscMain, newHscEnv, hscCmmFile, 
+       hscFileCheck,
 #ifdef GHCI
-       , hscStmt, hscTcExpr, hscKcType
-       , hscGetInfo, GetInfoResult
-       , compileExpr
+       hscStmt, hscTcExpr, hscKcType,
+       hscGetInfo, GetInfoResult,
+       compileExpr,
 #endif
        ) where
 
@@ -19,38 +21,41 @@ module HscMain (
 #ifdef GHCI
 import HsSyn           ( Stmt(..), LStmt, LHsExpr, LHsType )
 import IfaceSyn                ( IfaceDecl, IfaceInst )
+import Module          ( Module )
 import CodeOutput      ( outputForeignStubs )
 import ByteCodeGen     ( byteCodeGen, coreExprToBCOs )
 import Linker          ( HValue, linkExpr )
 import TidyPgm         ( tidyCoreExpr )
 import CorePrep                ( corePrepExpr )
 import Flattening      ( flattenExpr )
-import TcRnDriver      ( tcRnStmt, tcRnExpr, tcRnGetInfo, tcRnType ) 
+import TcRnDriver      ( tcRnStmt, tcRnExpr, tcRnGetInfo, GetInfoResult, tcRnType ) 
 import RdrName         ( rdrNameOcc )
 import OccName         ( occNameUserString )
 import Type            ( Type )
 import PrelNames       ( iNTERACTIVE )
 import StringBuffer    ( stringToStringBuffer )
 import Kind            ( Kind )
-import Var             ( Id )
 import CoreLint                ( lintUnfolding )
 import DsMeta          ( templateHaskellNames )
 import BasicTypes      ( Fixity )
+import SrcLoc          ( SrcLoc, noSrcLoc )
 #endif
 
-import RdrName         ( RdrName )
-import HsSyn           ( HsModule )
-import SrcLoc          ( SrcLoc, noSrcLoc, Located(..) )
+import Var             ( Id )
+import Module          ( emptyModuleEnv )
+import RdrName         ( GlobalRdrEnv, RdrName )
+import HsSyn           ( HsModule, LHsBinds )
+import SrcLoc          ( Located(..) )
 import StringBuffer    ( hGetStringBuffer )
 import Parser
 import Lexer           ( P(..), ParseResult(..), mkPState )
 import SrcLoc          ( mkSrcLoc )
 import TcRnDriver      ( tcRnModule, tcRnExtCore )
+import TcRnTypes       ( TcGblEnv(..) )
 import TcIface         ( typecheckIface )
 import IfaceEnv                ( initNameCache )
 import LoadIface       ( ifaceStats, initExternalPackageState )
 import PrelInfo                ( wiredInThings, basicKnownKeyNames )
-import RdrName         ( GlobalRdrEnv )
 import MkIface         ( checkOldIface, mkIface )
 import Desugar
 import Flattening       ( flatten )
@@ -64,8 +69,8 @@ import CodeGen                ( codeGen )
 import CmmParse                ( parseCmmFile )
 import CodeOutput      ( codeOutput )
 
-import CmdLineOpts
-import DriverPhases     ( isExtCoreFilename )
+import DynFlags
+import DriverPhases     ( HscSource(..) )
 import ErrUtils
 import UniqSupply      ( mkSplitUniqSupply )
 
@@ -75,14 +80,13 @@ import HscTypes
 import MkExternalCore  ( emitExternalCore )
 import ParserCore
 import ParserCoreUtils
-import Module          ( Module, ModLocation(..), showModMsg )
 import FastString
 import Maybes          ( expectJust )
 import StringBuffer    ( StringBuffer )
 import Bag             ( unitBag, emptyBag )
 
 import Monad           ( when )
-import Maybe           ( isJust, fromJust )
+import Maybe           ( isJust )
 import IO
 import DATA_IOREF      ( newIORef, readIORef )
 \end{code}
@@ -95,16 +99,20 @@ import DATA_IOREF   ( newIORef, readIORef )
 %************************************************************************
 
 \begin{code}
-newHscEnv :: GhciMode -> DynFlags -> IO HscEnv
-newHscEnv ghci_mode dflags
+newHscEnv :: DynFlags -> IO HscEnv
+newHscEnv dflags
   = do         { eps_var <- newIORef initExternalPackageState
        ; us      <- mkSplitUniqSupply 'r'
        ; nc_var  <- newIORef (initNameCache us knownKeyNames)
-       ; return (HscEnv { hsc_mode   = ghci_mode,
-                          hsc_dflags = dflags,
+       ; fc_var  <- newIORef emptyModuleEnv
+       ; return (HscEnv { hsc_dflags = dflags,
+                          hsc_targets = [],
+                          hsc_mod_graph = [],
+                          hsc_IC     = emptyInteractiveContext,
                           hsc_HPT    = emptyHomePackageTable,
                           hsc_EPS    = eps_var,
-                          hsc_NC     = nc_var } ) }
+                          hsc_NC     = nc_var,
+                          hsc_FC     = fc_var } ) }
                        
 
 knownKeyNames :: [Name]        -- Put here to avoid loops involving DsMeta,
@@ -129,7 +137,7 @@ data HscResult
    = HscFail
 
    -- In IDE mode: we just do the static/dynamic checks
-   | HscChecked (Located (HsModule RdrName))
+   | HscChecked (Located (HsModule RdrName)) (Maybe (LHsBinds Id, GlobalRdrEnv))
 
    -- Concluded that it wasn't necessary
    | HscNoRecomp ModDetails             -- new details (HomeSymbolTable additions)
@@ -137,7 +145,6 @@ data HscResult
 
    -- Did recompilation
    | HscRecomp   ModDetails            -- new details (HomeSymbolTable additions)
-                (Maybe GlobalRdrEnv)           
                  ModIface              -- new iface (if any compilation was done)
                 Bool                   -- stub_h exists
                 Bool                   -- stub_c exists
@@ -152,36 +159,35 @@ type MessageAction = Messages -> IO ()
 
 hscMain
   :: HscEnv
-  -> MessageAction             -- what to do with errors/warnings
-  -> Module
-  -> ModLocation               -- location info
-  -> Bool                      -- True <=> source unchanged
-  -> Bool                      -- True <=> have an object file (for msgs only)
-  -> Maybe ModIface            -- old interface, if available
+  -> MessageAction     -- What to do with errors/warnings
+  -> ModSummary
+  -> Bool              -- True <=> source unchanged
+  -> Bool              -- True <=> have an object file (for msgs only)
+  -> Maybe ModIface    -- Old interface, if available
   -> IO HscResult
 
-hscMain hsc_env msg_act mod location 
+hscMain hsc_env msg_act mod_summary
        source_unchanged have_object maybe_old_iface
  = do {
       (recomp_reqd, maybe_checked_iface) <- 
-               _scc_ "checkOldIface" 
-               checkOldIface hsc_env mod 
-                             (ml_hi_file location)
+               {-# SCC "checkOldIface" #-}
+               checkOldIface hsc_env mod_summary 
                              source_unchanged maybe_old_iface;
 
       let no_old_iface = not (isJust maybe_checked_iface)
           what_next | recomp_reqd || no_old_iface = hscRecomp 
                     | otherwise                   = hscNoRecomp
 
-      ; what_next hsc_env msg_act have_object 
-                 mod location maybe_checked_iface
+      ; what_next hsc_env msg_act mod_summary have_object 
+                 maybe_checked_iface
       }
 
 
+------------------------------
 -- hscNoRecomp definitely expects to have the old interface available
-hscNoRecomp hsc_env msg_act have_object 
-           mod location (Just old_iface)
- | isOneShot (hsc_mode hsc_env)
+hscNoRecomp hsc_env msg_act mod_summary 
+           have_object (Just old_iface)
+ | isOneShot (ghcMode (hsc_dflags hsc_env))
  = do {
       compilationProgressMsg (hsc_dflags hsc_env) $
        "compilation IS NOT required";
@@ -191,48 +197,171 @@ hscNoRecomp hsc_env msg_act have_object
       return (HscNoRecomp bomb bomb)
       }
  | otherwise
- = do {
-      compilationProgressMsg (hsc_dflags hsc_env) $
-       ("Skipping  " ++ showModMsg have_object mod location);
+ = do  { compilationProgressMsg (hsc_dflags hsc_env) $
+               ("Skipping  " ++ showModMsg have_object mod_summary)
 
-      new_details <- _scc_ "tcRnIface"
+       ; new_details <- {-# SCC "tcRnIface" #-}
                     typecheckIface hsc_env old_iface ;
-      dumpIfaceStats hsc_env ;
+       ; dumpIfaceStats hsc_env
 
-      return (HscNoRecomp new_details old_iface)
-      }
+       ; return (HscNoRecomp new_details old_iface)
+    }
 
-hscRecomp hsc_env msg_act have_object 
-         mod location maybe_checked_iface
- = do  {
-         -- what target are we shooting for?
-       ; let one_shot  = isOneShot (hsc_mode hsc_env)
-       ; let dflags    = hsc_dflags hsc_env
-       ; let toInterp  = dopt_HscLang dflags == HscInterpreted
-       ; let toCore    = isJust (ml_hs_file location) &&
-                         isExtCoreFilename (fromJust (ml_hs_file location))
+------------------------------
+hscRecomp hsc_env msg_act mod_summary
+         have_object maybe_checked_iface
+ = case ms_hsc_src mod_summary of
+     HsSrcFile -> do 
+       front_res <- hscFileFrontEnd hsc_env msg_act mod_summary
+       hscBackEnd hsc_env mod_summary maybe_checked_iface front_res
+
+     HsBootFile -> do
+       front_res <- hscFileFrontEnd hsc_env msg_act mod_summary
+       hscBootBackEnd hsc_env mod_summary maybe_checked_iface front_res
+
+     ExtCoreFile -> do
+       front_res <- hscCoreFrontEnd hsc_env msg_act mod_summary
+       hscBackEnd hsc_env mod_summary maybe_checked_iface front_res
+
+hscCoreFrontEnd hsc_env msg_act mod_summary = do {
+           -------------------
+           -- PARSE
+           -------------------
+       ; inp <- readFile (expectJust "hscCoreFrontEnd" (ms_hspp_file mod_summary))
+       ; case parseCore inp 1 of
+           FailP s        -> putMsg s{-ToDo: wrong-} >> return Nothing
+           OkP rdr_module -> do {
+    
+           -------------------
+           -- RENAME and TYPECHECK
+           -------------------
+       ; (tc_msgs, maybe_tc_result) <- {-# SCC "TypeCheck" #-}
+                             tcRnExtCore hsc_env rdr_module
+       ; msg_act tc_msgs
+       ; case maybe_tc_result of
+            Nothing       -> return Nothing
+            Just mod_guts -> return (Just mod_guts)    -- No desugaring to do!
+       }}
+        
 
+hscFileFrontEnd hsc_env msg_act mod_summary = do {
+           -------------------
+           -- DISPLAY PROGRESS MESSAGE
+           -------------------
+         let one_shot  = isOneShot (ghcMode (hsc_dflags hsc_env))
+       ; let dflags    = hsc_dflags hsc_env
+       ; let toInterp  = hscTarget dflags == HscInterpreted
        ; when (not one_shot) $
-               compilationProgressMsg dflags $
-                 ("Compiling " ++ showModMsg (not toInterp) mod location);
+                compilationProgressMsg dflags $
+                ("Compiling " ++ showModMsg (not toInterp) mod_summary)
                        
-       ; front_res <- if toCore then 
-                         hscCoreFrontEnd hsc_env msg_act location
-                      else 
-                         hscFileFrontEnd hsc_env msg_act location
+           -------------------
+           -- PARSE
+           -------------------
+       ; let hspp_file = expectJust "hscFileFrontEnd" (ms_hspp_file mod_summary)
+             hspp_buf  = ms_hspp_buf  mod_summary
+
+       ; maybe_parsed <- myParseModule (hsc_dflags hsc_env) hspp_file hspp_buf
+
+       ; case maybe_parsed of {
+            Left err -> do { msg_act (unitBag err, emptyBag)
+                           ; return Nothing } ;
+            Right rdr_module -> do {
+
+           -------------------
+           -- RENAME and TYPECHECK
+           -------------------
+         (tc_msgs, maybe_tc_result) 
+               <- {-# SCC "Typecheck-Rename" #-}
+                  tcRnModule hsc_env (ms_hsc_src mod_summary) rdr_module
+
+       ; msg_act tc_msgs
+       ; case maybe_tc_result of {
+            Nothing -> return Nothing ;
+            Just tc_result -> do {
+
+           -------------------
+           -- DESUGAR
+           -------------------
+       ; (warns, maybe_ds_result) <- {-# SCC "DeSugar" #-}
+                            deSugar hsc_env tc_result
+       ; msg_act (warns, emptyBag)
+       ; case maybe_ds_result of
+           Nothing        -> return Nothing
+           Just ds_result -> return (Just ds_result)
+       }}}}}
+
+------------------------------
+
+hscFileCheck :: HscEnv -> MessageAction -> ModSummary -> IO HscResult
+hscFileCheck hsc_env msg_act mod_summary = do {
+           -------------------
+           -- PARSE
+           -------------------
+       ; let hspp_file = expectJust "hscFileFrontEnd" (ms_hspp_file mod_summary)
+             hspp_buf  = ms_hspp_buf  mod_summary
+
+       ; maybe_parsed <- myParseModule (hsc_dflags hsc_env) hspp_file hspp_buf
+
+       ; case maybe_parsed of {
+            Left err -> do { msg_act (unitBag err, emptyBag)
+                           ; return HscFail } ;
+            Right rdr_module -> do {
+
+           -------------------
+           -- RENAME and TYPECHECK
+           -------------------
+         (tc_msgs, maybe_tc_result) 
+               <- _scc_ "Typecheck-Rename" 
+                  tcRnModule hsc_env (ms_hsc_src mod_summary) rdr_module
+
+       ; msg_act tc_msgs
+       ; case maybe_tc_result of {
+            Nothing -> return (HscChecked rdr_module Nothing);
+            Just tc_result -> return (HscChecked rdr_module 
+                                       (Just (tcg_binds tc_result,
+                                              tcg_rdr_env tc_result)))
+       }}}}    
+
+------------------------------
+hscBootBackEnd :: HscEnv -> ModSummary -> Maybe ModIface -> Maybe ModGuts -> IO HscResult
+-- For hs-boot files, there's no code generation to do
+
+hscBootBackEnd hsc_env mod_summary maybe_checked_iface Nothing 
+  = return HscFail
+hscBootBackEnd hsc_env mod_summary maybe_checked_iface (Just ds_result)
+  = do { final_iface <- {-# SCC "MkFinalIface" #-}
+                        mkIface hsc_env (ms_location mod_summary)
+                                maybe_checked_iface ds_result
+
+       ; let { final_details = ModDetails { md_types = mg_types ds_result,
+                                            md_insts = mg_insts ds_result,
+                                            md_rules = mg_rules ds_result } }
+         -- And the answer is ...
+       ; dumpIfaceStats hsc_env
 
-       ; case front_res of
-           Left flure -> return flure;
-           Right ds_result -> do {
+       ; return (HscRecomp final_details
+                           final_iface
+                            False False Nothing)
+       }
+
+------------------------------
+hscBackEnd :: HscEnv -> ModSummary -> Maybe ModIface -> Maybe ModGuts -> IO HscResult
+
+hscBackEnd hsc_env mod_summary maybe_checked_iface Nothing 
+  = return HscFail
 
+hscBackEnd hsc_env mod_summary maybe_checked_iface (Just ds_result) 
+  = do         {       -- OMITTED: 
+               -- ; seqList imported_modules (return ())
 
-       -- OMITTED: 
-       -- ; seqList imported_modules (return ())
+         let one_shot  = isOneShot (ghcMode dflags)
+             dflags    = hsc_dflags hsc_env
 
            -------------------
            -- FLATTENING
            -------------------
-       ; flat_result <- _scc_ "Flattening"
+       ; flat_result <- {-# SCC "Flattening" #-}
                         flatten hsc_env ds_result
 
 
@@ -262,13 +391,13 @@ hscRecomp hsc_env msg_act have_object
            -------------------
            -- SIMPLIFY
            -------------------
-       ; simpl_result <- _scc_ "Core2Core"
+       ; simpl_result <- {-# SCC "Core2Core" #-}
                          core2core hsc_env flat_result
 
            -------------------
            -- TIDY
            -------------------
-       ; tidy_result <- _scc_ "CoreTidy"
+       ; tidy_result <- {-# SCC "CoreTidy" #-}
                         tidyCorePgm hsc_env simpl_result
 
        -- Emit external core
@@ -284,20 +413,16 @@ hscRecomp hsc_env msg_act have_object
            -- This has to happen *after* code gen so that the back-end
            -- info has been set.  Not yet clear if it matters waiting
            -- until after code output
-       ; new_iface <- _scc_ "MkFinalIface" 
-                       mkIface hsc_env location 
+       ; new_iface <- {-# SCC "MkFinalIface" #-}
+                       mkIface hsc_env (ms_location mod_summary)
                                maybe_checked_iface tidy_result
 
-
            -- Space leak reduction: throw away the new interface if
            -- we're in one-shot mode; we won't be needing it any
            -- more.
        ; final_iface <-
             if one_shot then return (error "no final iface")
                         else return new_iface
-       ; let { final_globals | one_shot  = Nothing
-                             | otherwise = Just $! (mg_rdr_env tidy_result) }
-       ; final_globals `seq` return ()
 
            -- Build the final ModDetails (except in one-shot mode, where
            -- we won't need this information after compilation).
@@ -311,97 +436,20 @@ hscRecomp hsc_env msg_act have_object
            -------------------
            -- CONVERT TO STG and COMPLETE CODE GENERATION
        ; (stub_h_exists, stub_c_exists, maybe_bcos)
-               <- hscBackEnd dflags tidy_result
+               <- hscCodeGen dflags tidy_result
 
          -- And the answer is ...
        ; dumpIfaceStats hsc_env
 
        ; return (HscRecomp final_details
-                           final_globals
                            final_iface
                             stub_h_exists stub_c_exists
                            maybe_bcos)
-        }}
-
-hscCoreFrontEnd hsc_env msg_act location = do {
-           -------------------
-           -- PARSE
-           -------------------
-       ; inp <- readFile (expectJust "hscCoreFrontEnd:hspp" (ml_hspp_file location))
-       ; case parseCore inp 1 of
-           FailP s        -> putMsg s{-ToDo: wrong-} >> return (Left HscFail)
-           OkP rdr_module -> do {
-    
-           -------------------
-           -- RENAME and TYPECHECK
-           -------------------
-       ; (tc_msgs, maybe_tc_result) <- _scc_ "TypeCheck" 
-                             tcRnExtCore hsc_env rdr_module
-       ; msg_act tc_msgs
-       ; case maybe_tc_result of {
-            Nothing       -> return (Left  HscFail);
-            Just mod_guts -> return (Right mod_guts)
-                                       -- No desugaring to do!
-       }}}
-        
+        }
 
-hscFileFrontEnd hsc_env msg_act location = do {
-           -------------------
-           -- PARSE
-           -------------------
-       ; maybe_parsed <- myParseModule (hsc_dflags hsc_env) 
-                             (expectJust "hscFrontEnd:hspp" (ml_hspp_file location))
-
-       ; case maybe_parsed of {
-            Left err -> do { msg_act (unitBag err, emptyBag) ;
-                           ; return (Left HscFail) ;
-                           };
-            Right rdr_module -> hscFrontEnd hsc_env msg_act rdr_module
-    }}
-
--- Perform static/dynamic checks on the source code in a StringBuffer
--- This is a temporary solution: it'll read in interface files lazily, whereas
--- we probably want to use the compilation manager to load in all the modules
--- in a project.
-hscBufferFrontEnd :: HscEnv -> StringBuffer -> MessageAction -> IO HscResult
-hscBufferFrontEnd hsc_env buffer msg_act = do
-       let loc  = mkSrcLoc (mkFastString "*edit*") 1 0
-        showPass (hsc_dflags hsc_env) "Parser"
-       case unP parseModule (mkPState buffer loc (hsc_dflags hsc_env)) of
-               PFailed span err -> do
-                       msg_act (emptyBag, unitBag (mkPlainErrMsg span err))
-                       return HscFail
-               POk _ rdr_module -> do 
-                       r <- hscFrontEnd hsc_env msg_act rdr_module
-                       case r of
-                          Left r -> return r
-                          Right _ -> return (HscChecked rdr_module)
-
-
-
-hscFrontEnd hsc_env msg_act rdr_module  = do {
-           -------------------
-           -- RENAME and TYPECHECK
-           -------------------
-       ; (tc_msgs, maybe_tc_result) <- _scc_ "Typecheck-Rename" 
-                                       tcRnModule hsc_env rdr_module
-       ; msg_act tc_msgs
-       ; case maybe_tc_result of {
-            Nothing -> return (Left HscFail);
-            Just tc_result -> do {
 
-           -------------------
-           -- DESUGAR
-           -------------------
-       ; (warns, maybe_ds_result) <- _scc_ "DeSugar" 
-                            deSugar hsc_env tc_result
-       ; msg_act (warns, emptyBag)
-       ; case maybe_ds_result of
-           Nothing        -> return (Left HscFail);
-           Just ds_result -> return (Right ds_result);
-       }}}
 
-hscBackEnd dflags 
+hscCodeGen dflags 
     ModGuts{  -- This is the last use of the ModGuts in a compilation.
              -- From now on, we just use the bits we need.
         mg_module   = this_mod,
@@ -414,10 +462,10 @@ hscBackEnd dflags
            -------------------
            -- PREPARE FOR CODE GENERATION
            -- Do saturation and convert to A-normal form
-  prepd_binds <- _scc_ "CorePrep"
+  prepd_binds <- {-# SCC "CorePrep" #-}
                 corePrepPgm dflags core_binds type_env;
 
-  case dopt_HscLang dflags of
+  case hscTarget dflags of
       HscNothing -> return (False, False, Nothing)
 
       HscInterpreted ->
@@ -437,11 +485,11 @@ hscBackEnd dflags
       other ->
        do
            -----------------  Convert to STG ------------------
-           (stg_binds, cost_centre_info) <- _scc_ "CoreToStg"
+           (stg_binds, cost_centre_info) <- {-# SCC "CoreToStg" #-}
                         myCoreToStg dflags this_mod prepd_binds        
 
             ------------------  Code generation ------------------
-           abstractC <- _scc_ "CodeGen"
+           abstractC <- {-# SCC "CodeGen" #-}
                         codeGen dflags this_mod type_env foreign_stubs
                                 dir_imps cost_centre_info stg_binds
 
@@ -466,11 +514,17 @@ hscCmmFile dflags filename = do
        no_mod = panic "hscCmmFile: no_mod"
 
 
-myParseModule dflags src_filename
- = do --------------------------  Parser  ----------------
-      showPass dflags "Parser"
-      _scc_  "Parser" do
-      buf <- hGetStringBuffer src_filename
+myParseModule dflags src_filename maybe_src_buf
+ =    --------------------------  Parser  ----------------
+      showPass dflags "Parser" >>
+      {-# SCC "Parser" #-} do
+
+       -- sometimes we already have the buffer in memory, perhaps
+       -- because we needed to parse the imports out of it, or get the 
+       -- module name.
+      buf <- case maybe_src_buf of
+               Just b  -> return b
+               Nothing -> hGetStringBuffer src_filename
 
       let loc  = mkSrcLoc (mkFastString src_filename) 1 0
 
@@ -492,10 +546,10 @@ myParseModule dflags src_filename
 
 myCoreToStg dflags this_mod prepd_binds
  = do 
-      stg_binds <- _scc_ "Core2Stg" 
+      stg_binds <- {-# SCC "Core2Stg" #-}
             coreToStg dflags prepd_binds
 
-      (stg_binds2, cost_centre_info) <- _scc_ "Core2Stg" 
+      (stg_binds2, cost_centre_info) <- {-# SCC "Core2Stg" #-}
             stg2stg dflags this_mod stg_binds
 
       return (stg_binds2, cost_centre_info)
@@ -538,11 +592,10 @@ A naked expression returns a singleton Name [it].
 #ifdef GHCI
 hscStmt                -- Compile a stmt all the way to an HValue, but don't run it
   :: HscEnv
-  -> InteractiveContext                -- Context for compiling
   -> String                    -- The statement
-  -> IO (Maybe (InteractiveContext, [Name], HValue))
+  -> IO (Maybe (HscEnv, [Name], HValue))
 
-hscStmt hsc_env icontext stmt
+hscStmt hsc_env stmt
   = do { maybe_stmt <- hscParseStmt (hsc_dflags hsc_env) stmt
        ; case maybe_stmt of {
             Nothing      -> return Nothing ;   -- Parse error
@@ -550,8 +603,8 @@ hscStmt hsc_env icontext stmt
             Just (Just parsed_stmt) -> do {    -- The real stuff
 
                -- Rename and typecheck it
-         maybe_tc_result
-                <- tcRnStmt hsc_env icontext parsed_stmt
+         let icontext = hsc_IC hsc_env
+       ; maybe_tc_result <- tcRnStmt hsc_env icontext parsed_stmt
 
        ; case maybe_tc_result of {
                Nothing -> return Nothing ;
@@ -563,20 +616,20 @@ hscStmt hsc_env icontext stmt
                              (ic_type_env new_ic)
                              tc_expr
 
-       ; return (Just (new_ic, bound_names, hval))
+       ; return (Just (hsc_env{ hsc_IC=new_ic }, bound_names, hval))
        }}}}}
 
 hscTcExpr      -- Typecheck an expression (but don't run it)
   :: HscEnv
-  -> InteractiveContext                -- Context for compiling
   -> String                    -- The expression
   -> IO (Maybe Type)
 
-hscTcExpr hsc_env icontext expr
+hscTcExpr hsc_env expr
   = do { maybe_stmt <- hscParseStmt (hsc_dflags hsc_env) expr
+       ; let icontext = hsc_IC hsc_env
        ; case maybe_stmt of {
             Nothing      -> return Nothing ;   -- Parse error
-            Just (Just (L _ (ExprStmt expr _)))
+            Just (Just (L _ (ExprStmt expr _ _)))
                        -> tcRnExpr hsc_env icontext expr ;
             Just other -> do { errorMsg ("not an expression: `" ++ expr ++ "'") ;
                                return Nothing } ;
@@ -584,12 +637,12 @@ hscTcExpr hsc_env icontext expr
 
 hscKcType      -- Find the kind of a type
   :: HscEnv
-  -> InteractiveContext                -- Context for compiling
   -> String                    -- The type
   -> IO (Maybe Kind)
 
-hscKcType hsc_env icontext str
+hscKcType hsc_env str
   = do { maybe_type <- hscParseType (hsc_dflags hsc_env) str
+       ; let icontext = hsc_IC hsc_env
        ; case maybe_type of {
             Just ty    -> tcRnType hsc_env icontext ty ;
             Just other -> do { errorMsg ("not an type: `" ++ str ++ "'") ;
@@ -614,8 +667,8 @@ hscParseThing :: Outputable thing
        -- Nothing => Parse error (message already printed)
        -- Just x  => success
 hscParseThing parser dflags str
- = do showPass dflags "Parser"
-      _scc_ "Parser"  do
+ = showPass dflags "Parser" >>
+      {-# SCC "Parser" #-} do
 
       buf <- stringToStringBuffer str
 
@@ -644,30 +697,23 @@ hscParseThing parser dflags str
 
 \begin{code}
 #ifdef GHCI
-type GetInfoResult = (String, (IfaceDecl, Fixity, SrcLoc, [(IfaceInst,SrcLoc)]))
-
 hscGetInfo -- like hscStmt, but deals with a single identifier
   :: HscEnv
-  -> InteractiveContext                -- Context for compiling
   -> String                    -- The identifier
   -> IO [GetInfoResult]
 
-hscGetInfo hsc_env ic str
+hscGetInfo hsc_env str
    = do maybe_rdr_name <- hscParseIdentifier (hsc_dflags hsc_env) str
        case maybe_rdr_name of {
          Nothing -> return [];
          Just (L _ rdr_name) -> do
 
-       maybe_tc_result <- tcRnGetInfo hsc_env ic rdr_name
-
-       let     -- str' is the the naked occurrence name
-               -- after stripping off qualification and parens (+)
-          str' = occNameUserString (rdrNameOcc rdr_name)
+       maybe_tc_result <- tcRnGetInfo hsc_env (hsc_IC hsc_env) rdr_name
 
-       case maybe_tc_result of {
-            Nothing     -> return [] ;
-            Just things -> return [(str', t) | t <- things]
-       }}
+       case maybe_tc_result of
+            Nothing     -> return []
+            Just things -> return things
+       }
 #endif
 \end{code}