Fix segfault in array copy primops on 32-bit
[ghc-hetmet.git] / compiler / main / InteractiveEval.hs
index db1fd41..bb5fab6 100644 (file)
@@ -9,7 +9,8 @@
 module InteractiveEval (
 #ifdef GHCI
         RunResult(..), Status(..), Resume(..), History(..),
-       runStmt, parseImportDecl, SingleStep(..),
+       runStmt, runStmtWithLocation,
+        parseImportDecl, SingleStep(..),
         resume,
         abandon, abandonAll,
         getResumeContext,
@@ -29,9 +30,7 @@ module InteractiveEval (
        showModule,
         isModuleInterpreted,
        compileExpr, dynCompileExpr,
-       lookupName,
-        Term(..), obtainTermFromId, obtainTermFromVal, reconstructType,
-        skolemiseSubst, skolemiseTy
+        Term(..), obtainTermFromId, obtainTermFromVal, reconstructType
 #endif
         ) where
 
@@ -39,12 +38,11 @@ module InteractiveEval (
 
 #include "HsVersions.h"
 
-import HscMain          hiding (compileExpr)
-import HsSyn (ImportDecl)
+import GhcMonad
+import HscMain
+import HsSyn
 import HscTypes
-import TcRnDriver
-import TcRnMonad (initTc)
-import RnNames         (gresFromAvails, rnImports)
+import RnNames          (gresFromAvails)
 import InstEnv
 import Type
 import TcType          hiding( typeKind )
@@ -66,28 +64,26 @@ import Panic
 import UniqFM
 import Maybes
 import ErrUtils
-import Util
 import SrcLoc
 import BreakArray
 import RtClosureInspect
-import BasicTypes
 import Outputable
 import FastString
 import MonadUtils
 
 import System.Directory
 import Data.Dynamic
-import Data.List (find, partition)
+import Data.List (find)
 import Control.Monad
-import Foreign
+import Foreign hiding (unsafePerformIO)
 import Foreign.C
 import GHC.Exts
 import Data.Array
 import Exception
 import Control.Concurrent
-import Data.List (sortBy)
 -- import Foreign.StablePtr
 import System.IO
+import System.IO.Unsafe
 
 -- -----------------------------------------------------------------------------
 -- running a statement interactively
@@ -110,7 +106,7 @@ data Resume
        resumeThreadId  :: ThreadId,     -- thread running the computation
        resumeBreakMVar :: MVar (),   
        resumeStatMVar  :: MVar Status,
-       resumeBindings  :: ([Id], TyVarSet),
+       resumeBindings  :: [Id],
        resumeFinalIds  :: [Id],         -- [Id] to bind on completion
        resumeApStack   :: HValue,       -- The object from which we can get
                                         -- value of the free variables.
@@ -140,16 +136,14 @@ data History
    = History {
         historyApStack   :: HValue,
         historyBreakInfo :: BreakInfo,
-        historyEnclosingDecl :: Id
-         -- ^^ A cache of the enclosing top level declaration, for convenience
+        historyEnclosingDecls :: [String]  -- declarations enclosing the breakpoint
    }
 
 mkHistory :: HscEnv -> HValue -> BreakInfo -> History
 mkHistory hsc_env hval bi = let
-    h    = History hval bi decl
-    decl = findEnclosingDecl hsc_env (getHistoryModule h)
-                                     (getHistorySpan hsc_env h)
-    in h
+    decls = findEnclosingDecls hsc_env bi
+    in History hval bi decls
+
 
 getHistoryModule :: History -> Module
 getHistoryModule = breakInfo_module . historyBreakInfo
@@ -164,7 +158,7 @@ getHistorySpan hsc_env hist =
 
 getModBreaks :: HomeModInfo -> ModBreaks
 getModBreaks hmi
-  | Just linkable <- hm_linkable hmi, 
+  | Just linkable <- hm_linkable hmi,
     [BCOs _ modBreaks] <- linkableUnlinked linkable
   = modBreaks
   | otherwise
@@ -174,23 +168,24 @@ getModBreaks hmi
 -- ToDo: a better way to do this would be to keep hold of the decl_path computed
 -- by the coverage pass, which gives the list of lexically-enclosing bindings
 -- for each tick.
-findEnclosingDecl :: HscEnv -> Module -> SrcSpan -> Id
-findEnclosingDecl hsc_env mod span =
-   case lookupUFM (hsc_HPT hsc_env) (moduleName mod) of
-         Nothing -> panic "findEnclosingDecl"
-         Just hmi -> let
-             globals   = typeEnvIds (md_types (hm_details hmi))
-             Just decl = 
-                 find (\id -> let n = idName id in 
-                               nameSrcSpan n < span && isExternalName n)
-                      (reverse$ sortBy (compare `on` (nameSrcSpan.idName))
-                                       globals)
-           in decl
+findEnclosingDecls :: HscEnv -> BreakInfo -> [String]
+findEnclosingDecls hsc_env inf =
+   let hmi = expectJust "findEnclosingDecls" $
+             lookupUFM (hsc_HPT hsc_env) (moduleName $ breakInfo_module inf)
+       mb = getModBreaks hmi
+   in modBreaks_decls mb ! breakInfo_number inf
+
 
 -- | Run a statement in the current interactive context.  Statement
 -- may bind multple values.
 runStmt :: GhcMonad m => String -> SingleStep -> m RunResult
-runStmt expr step =
+runStmt = runStmtWithLocation "<interactive>" 1
+
+-- | Run a statement in the current interactive context.  Passing debug information
+--   Statement may bind multple values.
+runStmtWithLocation :: GhcMonad m => String -> Int -> 
+                       String -> SingleStep -> m RunResult 
+runStmtWithLocation source linenumber expr step =
   do
     hsc_env <- getSession
 
@@ -202,20 +197,12 @@ runStmt expr step =
     let dflags'  = dopt_unset (hsc_dflags hsc_env) Opt_WarnUnusedBinds
         hsc_env' = hsc_env{ hsc_dflags = dflags' }
 
-    r <- hscStmt hsc_env' expr
+    r <- liftIO $ hscStmtWithLocation hsc_env' expr source linenumber
 
     case r of
       Nothing -> return RunFailed -- empty statement / comment
 
       Just (ids, hval) -> do
-          -- XXX: This is the only place we can print warnings before the
-          -- result.  Is this really the right thing to do?  It's fine for
-          -- GHCi, but what's correct for other GHC API clients?  We could
-          -- introduce a callback argument.
-        warns <- getWarnings
-        liftIO $ printBagOfWarnings dflags' warns
-        clearWarnings
-
         status <-
           withVirtualCWD $
             withBreakAction (isStep step) dflags' breakMVar statusMVar $ do
@@ -223,7 +210,7 @@ runStmt expr step =
                 liftIO $ sandboxIO dflags' statusMVar thing_to_run
               
         let ic = hsc_IC hsc_env
-            bindings = (ic_tmp_ids ic, ic_tyvars ic)
+            bindings = ic_tmp_ids ic
 
         case step of
           RunAndLogSteps ->
@@ -255,13 +242,13 @@ withVirtualCWD m = do
   gbracket set_cwd reset_cwd $ \_ -> m
 
 parseImportDecl :: GhcMonad m => String -> m (ImportDecl RdrName)
-parseImportDecl expr = withSession $ \hsc_env -> hscImport hsc_env expr
+parseImportDecl expr = withSession $ \hsc_env -> liftIO $ hscImport hsc_env expr
 
 emptyHistory :: BoundedList History
 emptyHistory = nilBL 50 -- keep a log of length 50
 
 handleRunStatus :: GhcMonad m =>
-                   String-> ([Id], TyVarSet) -> [Id]
+                   String-> [Id] -> [Id]
                 -> MVar () -> MVar Status -> Status -> BoundedList History
                 -> m RunResult
 handleRunStatus expr bindings final_ids breakMVar statusMVar status
@@ -275,9 +262,12 @@ handleRunStatus expr bindings final_ids breakMVar statusMVar status
         (hsc_env1, names, span) <- liftIO $ bindLocalsAtBreakpoint hsc_env apStack
                                                                mb_info
         let
-            resume = Resume expr tid breakMVar statusMVar 
-                              bindings final_ids apStack mb_info span 
-                              (toListBL history) 0
+            resume = Resume { resumeStmt = expr, resumeThreadId = tid
+                            , resumeBreakMVar = breakMVar, resumeStatMVar = statusMVar 
+                            , resumeBindings = bindings, resumeFinalIds = final_ids
+                            , resumeApStack = apStack, resumeBreakInfo = mb_info 
+                            , resumeSpan = span, resumeHistory = toListBL history
+                            , resumeHistoryIx = 0 }
             hsc_env2 = pushResume hsc_env1 resume
         --
         modifySession (\_ -> hsc_env2)
@@ -287,9 +277,7 @@ handleRunStatus expr bindings final_ids breakMVar statusMVar status
            Left e -> return (RunException e)
            Right hvals -> do
                 hsc_env <- getSession
-                let final_ic = extendInteractiveContext (hsc_IC hsc_env)
-                                        final_ids emptyVarSet
-                        -- the bound Ids never have any free TyVars
+                let final_ic = extendInteractiveContext (hsc_IC hsc_env) final_ids 
                     final_names = map idName final_ids
                 liftIO $ Linker.extendLinkEnv (zip final_names hvals)
                 hsc_env' <- liftIO $ rttiEnvironment hsc_env{hsc_IC=final_ic}
@@ -297,7 +285,7 @@ handleRunStatus expr bindings final_ids breakMVar statusMVar status
                 return (RunOk final_names)
 
 traceRunStatus :: GhcMonad m =>
-                  String -> ([Id], TyVarSet) -> [Id]
+                  String -> [Id] -> [Id]
                -> MVar () -> MVar Status -> Status -> BoundedList History
                -> m RunResult
 traceRunStatus expr bindings final_ids
@@ -357,18 +345,25 @@ foreign import ccall "&rts_breakpoint_io_action"
 -- thread.  ToDo: we might want a way to continue even if the target
 -- thread doesn't die when it receives the exception... "this thread
 -- is not responding".
--- 
+--
 -- Careful here: there may be ^C exceptions flying around, so we start the new
--- thread blocked (forkIO inherits block from the parent, #1048), and unblock
+-- thread blocked (forkIO inherits mask from the parent, #1048), and unblock
 -- only while we execute the user's code.  We can't afford to lose the final
 -- putMVar, otherwise deadlock ensues. (#1583, #1922, #1946)
 sandboxIO :: DynFlags -> MVar Status -> IO [HValue] -> IO Status
 sandboxIO dflags statusMVar thing =
-   block $ do  -- fork starts blocked
-     id <- forkIO $ do res <- Exception.try (unblock $ rethrow dflags thing)
-                       putMVar statusMVar (Complete res) -- empty: can't block
-     withInterruptsSentTo id $ takeMVar statusMVar
-
+   mask $ \restore -> -- fork starts blocked
+     let runIt = liftM Complete $ try (restore $ rethrow dflags thing)
+     in if dopt Opt_GhciSandbox dflags
+        then do tid <- forkIO $ do res <- runIt
+                                   putMVar statusMVar res -- empty: can't block
+                withInterruptsSentTo tid $ takeMVar statusMVar
+        else -- GLUT on OS X needs to run on the main thread. If you
+             -- try to use it from another thread then you just get a
+             -- white rectangle rendered. For this, or anything else
+             -- with such restrictions, you can turn the GHCi sandbox off
+             -- and things will be run in the main thread.
+             runIt
 
 -- We want to turn ^C into a break when -fbreak-on-exception is on,
 -- but it's an async exception and we only break for sync exceptions.
@@ -450,9 +445,8 @@ resume canLogSpan step
         -- unbind the temporary locals by restoring the TypeEnv from
         -- before the breakpoint, and drop this Resume from the
         -- InteractiveContext.
-        let (resume_tmp_ids, resume_tyvars) = resumeBindings r
+        let resume_tmp_ids = resumeBindings r
             ic' = ic { ic_tmp_ids  = resume_tmp_ids,
-                       ic_tyvars   = resume_tyvars,
                        ic_resume   = rs }
         modifySession (\_ -> hsc_env{ hsc_IC = ic' })
         
@@ -464,8 +458,11 @@ resume canLogSpan step
         
         when (isStep step) $ liftIO setStepFlag
         case r of 
-          Resume expr tid breakMVar statusMVar bindings 
-              final_ids apStack info span hist _ -> do
+          Resume { resumeStmt = expr, resumeThreadId = tid
+                 , resumeBreakMVar = breakMVar, resumeStatMVar = statusMVar
+                 , resumeBindings = bindings, resumeFinalIds = final_ids
+                 , resumeApStack = apStack, resumeBreakInfo = info, resumeSpan = span
+                 , resumeHistory = hist } -> do
                withVirtualCWD $ do
                 withBreakAction (isStep step) (hsc_dflags hsc_env) 
                                         breakMVar statusMVar $ do
@@ -554,12 +551,11 @@ bindLocalsAtBreakpoint hsc_env apStack Nothing = do
        exn_name  = mkInternalName (getUnique exn_fs) (mkVarOccFS exn_fs) span
        e_fs      = fsLit "e"
        e_name    = mkInternalName (getUnique e_fs) (mkTyVarOccFS e_fs) span
-       e_tyvar   = mkTcTyVar e_name liftedTypeKind (SkolemTv RuntimeUnkSkol)
+       e_tyvar   = mkRuntimeUnkTyVar e_name liftedTypeKind
        exn_id    = Id.mkVanillaGlobal exn_name (mkTyVarTy e_tyvar)
-       new_tyvars = unitVarSet e_tyvar
 
        ictxt0 = hsc_IC hsc_env
-       ictxt1 = extendInteractiveContext ictxt0 [exn_id] new_tyvars
+       ictxt1 = extendInteractiveContext ictxt0 [exn_id]
 
        span = mkGeneralSrcSpan (fsLit "<exception thrown>")
    --
@@ -581,12 +577,16 @@ bindLocalsAtBreakpoint hsc_env apStack (Just info) = do
        occs      = modBreaks_vars breaks ! index
        span      = modBreaks_locs breaks ! index
 
-   -- filter out any unboxed ids; we can't bind these at the prompt
-   let pointers = filter (\(id,_) -> isPointer id) vars
+           -- Filter out any unboxed ids;
+           -- we can't bind these at the prompt
+       pointers = filter (\(id,_) -> isPointer id) vars
        isPointer id | PtrRep <- idPrimRep id = True
                     | otherwise              = False
 
-   let (ids, offsets) = unzip pointers
+       (ids, offsets) = unzip pointers
+
+       free_tvs = foldr (unionVarSet . tyVarsOfType . idType)
+                        (tyVarsOfType result_ty) ids
 
    -- It might be that getIdValFromApStack fails, because the AP_STACK
    -- has been accidentally evaluated, or something else has gone wrong.
@@ -598,20 +598,20 @@ bindLocalsAtBreakpoint hsc_env apStack (Just info) = do
       debugTraceMsg (hsc_dflags hsc_env) 1 $
          text "Warning: _result has been evaluated, some bindings have been lost"
 
-   new_ids <- zipWithM mkNewId occs filtered_ids
-   let names = map idName new_ids
+   us <- mkSplitUniqSupply 'I'
+   let (us1, us2) = splitUniqSupply us
+       tv_subst   = newTyVars us1 free_tvs
+       new_ids    = zipWith3 (mkNewId tv_subst) occs filtered_ids (uniqsFromSupply us2)
+       names      = map idName new_ids
 
    -- make an Id for _result.  We use the Unique of the FastString "_result";
    -- we don't care about uniqueness here, because there will only be one
    -- _result in scope at any time.
    let result_name = mkInternalName (getUnique result_fs)
                           (mkVarOccFS result_fs) span
-       result_id   = Id.mkVanillaGlobal result_name result_ty 
+       result_id   = Id.mkVanillaGlobal result_name (substTy tv_subst result_ty)
 
    -- for each Id we're about to bind in the local envt:
-   --    - skolemise the type variables in its type, so they can't
-   --      be randomly unified with other types.  These type variables
-   --      can only be resolved by type reconstruction in RtClosureInspect
    --    - tidy the type variables
    --    - globalise the Id (Ids are supposed to be Global, apparently).
    --
@@ -620,32 +620,36 @@ bindLocalsAtBreakpoint hsc_env apStack (Just info) = do
 
        all_ids | result_ok = result_id : new_ids
                | otherwise = new_ids
-       (id_tys, tyvarss) = mapAndUnzip (skolemiseTy.idType) all_ids
+       id_tys = map idType all_ids
        (_,tidy_tys) = tidyOpenTypes emptyTidyEnv id_tys
-       new_tyvars = unionVarSets tyvarss             
        final_ids = zipWith setIdType all_ids tidy_tys
        ictxt0 = hsc_IC hsc_env
-       ictxt1 = extendInteractiveContext ictxt0 final_ids new_tyvars
+       ictxt1 = extendInteractiveContext ictxt0 final_ids
 
    Linker.extendLinkEnv [ (name,hval) | (name, Just hval) <- zip names mb_hValues ]
    when result_ok $ Linker.extendLinkEnv [(result_name, unsafeCoerce# apStack)]
    hsc_env1 <- rttiEnvironment hsc_env{ hsc_IC = ictxt1 }
    return (hsc_env1, if result_ok then result_name:names else names, span)
   where
-   mkNewId :: OccName -> Id -> IO Id
-   mkNewId occ id = do
-     us <- mkSplitUniqSupply 'I'
-        -- we need a fresh Unique for each Id we bind, because the linker
+        -- We need a fresh Unique for each Id we bind, because the linker
         -- state is single-threaded and otherwise we'd spam old bindings
         -- whenever we stop at a breakpoint.  The InteractveContext is properly
         -- saved/restored, but not the linker state.  See #1743, test break026.
-     let 
-         uniq = uniqFromSupply us
-         loc = nameSrcSpan (idName id)
-         name = mkInternalName uniq occ loc
-         ty = idType id
-         new_id = Id.mkVanillaGlobalWithInfo name ty (idInfo id)
-     return new_id
+   mkNewId :: TvSubst -> OccName -> Id -> Unique -> Id
+   mkNewId tv_subst occ id uniq
+     = Id.mkVanillaGlobalWithInfo name ty (idInfo id)
+     where
+         loc    = nameSrcSpan (idName id)
+         name   = mkInternalName uniq occ loc
+         ty     = substTy tv_subst (idType id)
+
+   newTyVars :: UniqSupply -> TcTyVarSet -> TvSubst
+     -- Similarly, clone the type variables mentioned in the types
+     -- we have here, *and* make them all RuntimeUnk tyars
+   newTyVars us tvs
+     = mkTopTvSubst [ (tv, mkTyVarTy (mkRuntimeUnkTyVar name (tyVarKind tv)))
+                    | (tv, uniq) <- varSetElems tvs `zip` uniqsFromSupply us
+                    , let name = setNameUnique (tyVarName tv) uniq ]
 
 rttiEnvironment :: HscEnv -> IO HscEnv 
 rttiEnvironment hsc_env@HscEnv{hsc_IC=ic} = do
@@ -657,7 +661,7 @@ rttiEnvironment hsc_env@HscEnv{hsc_IC=ic} = do
    hsc_env' <- foldM improveTypes hsc_env (map idName incompletelyTypedIds)
    return hsc_env'
     where
-     noSkolems = null . filter isSkolemTyVar . varSetElems . tyVarsOfType . idType
+     noSkolems = isEmptyVarSet . tyVarsOfType . idType
      improveTypes hsc_env@HscEnv{hsc_IC=ic} name = do
       let InteractiveContext{ic_tmp_ids=tmp_ids} = ic
           Just id = find (\i -> idName i == name) tmp_ids
@@ -669,8 +673,7 @@ rttiEnvironment hsc_env@HscEnv{hsc_IC=ic} = do
            case mb_new_ty of
              Nothing -> return hsc_env
              Just new_ty -> do
-              mb_subst <- improveRTTIType hsc_env old_ty new_ty
-              case mb_subst of
+              case improveRTTIType hsc_env old_ty new_ty of
                Nothing -> return $
                         WARN(True, text (":print failed to calculate the "
                                            ++ "improvement for a type")) hsc_env
@@ -679,32 +682,10 @@ rttiEnvironment hsc_env@HscEnv{hsc_IC=ic} = do
                       printForUser stderr alwaysQualify $
                       fsep [text "RTTI Improvement for", ppr id, equals, ppr subst]
 
-                 let (subst', skols) = skolemiseSubst subst
-                     ic' = extendInteractiveContext
-                               (substInteractiveContext ic subst') [] skols
+                 let ic' = extendInteractiveContext
+                               (substInteractiveContext ic subst) []
                  return hsc_env{hsc_IC=ic'}
 
-skolemiseSubst :: TvSubst -> (TvSubst, TyVarSet)
-skolemiseSubst subst = let
-    varenv               = getTvSubstEnv subst
-    all_together         = mapVarEnv skolemiseTy varenv
-    (varenv', skol_vars) = ( mapVarEnv fst all_together
-                           , map snd (varEnvElts all_together))
-    in (subst `setTvSubstEnv` varenv', unionVarSets skol_vars)
-                        
-
-skolemiseTy :: Type -> (Type, TyVarSet)
-skolemiseTy ty = (substTy subst ty, mkVarSet new_tyvars)
-  where env           = mkVarEnv (zip tyvars new_tyvar_tys)
-        subst         = mkTvSubst emptyInScopeSet env
-        tyvars        = varSetElems (tyVarsOfType ty)
-        new_tyvars    = map skolemiseTyVar tyvars
-        new_tyvar_tys = map mkTyVarTy new_tyvars
-
-skolemiseTyVar :: TyVar -> TyVar
-skolemiseTyVar tyvar = mkTcTyVar (tyVarName tyvar) (tyVarKind tyvar) 
-                                 (SkolemTv RuntimeUnkSkol)
-
 getIdValFromApStack :: HValue -> Int -> IO (Maybe HValue)
 getIdValFromApStack apStack (I# stackDepth) = do
    case getApStackVal# apStack (stackDepth +# 1#) of
@@ -796,39 +777,27 @@ fromListBL bound l = BL (length l) bound l []
 -- module.  They always shadow anything in scope in the current context.
 setContext :: GhcMonad m =>
         [Module]       -- ^ entire top level scope of these modules
-        -> [(Module, Maybe (ImportDecl RdrName))]      -- ^ exports of these modules
+        -> [ImportDecl RdrName]       -- ^ these import declarations
         -> m ()
-setContext toplev_mods other_mods = do
+setContext toplev_mods import_decls = do
     hsc_env <- getSession
     let old_ic  = hsc_IC     hsc_env
         hpt     = hsc_HPT    hsc_env
-        (decls,mods)   = partition (isJust . snd) other_mods -- time for tracing
-        export_mods = map fst mods
-        imprt_decls = map noLoc (catMaybes (map snd decls))
+        imprt_decls = map noLoc import_decls
     --
-    export_env  <- liftIO $ mkExportEnv hsc_env export_mods
     import_env  <-
         if null imprt_decls then return emptyGlobalRdrEnv else do
-            let imports = rnImports imprt_decls
-                this_mod = if null toplev_mods then pRELUDE else head toplev_mods
-            (_, env, _,_) <-
-                ioMsgMaybe $ liftIO $ initTc hsc_env HsSrcFile False this_mod imports
-            return env
+            let this_mod | null toplev_mods = pRELUDE
+                         | otherwise        = head toplev_mods
+            liftIO $ hscRnImportDecls hsc_env this_mod imprt_decls
+
     toplev_envs <- liftIO $ mapM (mkTopLevEnv hpt) toplev_mods
-    let all_env = foldr plusGlobalRdrEnv (plusGlobalRdrEnv export_env import_env) toplev_envs
+
+    let all_env = foldr plusGlobalRdrEnv import_env toplev_envs
     modifySession $ \_ ->
         hsc_env{ hsc_IC = old_ic { ic_toplev_scope = toplev_mods,
-                        ic_exports      = other_mods,
-                        ic_rn_gbl_env   = all_env }}
-
--- Make a GlobalRdrEnv based on the exports of the modules only.
-mkExportEnv :: HscEnv -> [Module] -> IO GlobalRdrEnv
-mkExportEnv hsc_env mods
-  = do { stuff <- mapM (getModuleExports hsc_env) mods
-       ; let (_msgs, mb_name_sets) = unzip stuff
-            envs = [ availsToGlobalRdrEnv (moduleName mod) avails
-                    | (Just avails, mod) <- zip mb_name_sets mods ]
-       ; return $! foldr plusGlobalRdrEnv emptyGlobalRdrEnv envs }
+                                   ic_imports      = import_decls,
+                                   ic_rn_gbl_env   = all_env }}
 
 availsToGlobalRdrEnv :: ModuleName -> [AvailInfo] -> GlobalRdrEnv
 availsToGlobalRdrEnv mod_name avails
@@ -856,9 +825,9 @@ mkTopLevEnv hpt modl
 -- | Get the interactive evaluation context, consisting of a pair of the
 -- set of modules from which we take the full top-level scope, and the set
 -- of modules from which we take just the exports respectively.
-getContext :: GhcMonad m => m ([Module],[(Module, Maybe (ImportDecl RdrName))])
+getContext :: GhcMonad m => m ([Module],[ImportDecl RdrName])
 getContext = withSession $ \HscEnv{ hsc_IC=ic } ->
-              return (ic_toplev_scope ic, ic_exports ic)
+               return (ic_toplev_scope ic, ic_imports ic)
 
 -- | Returns @True@ if the specified module is interpreted, and hence has
 -- its full top-level scope available.
@@ -878,7 +847,7 @@ moduleIsInterpreted modl = withSession $ \h ->
 getInfo :: GhcMonad m => Name -> m (Maybe (TyThing,Fixity,[Instance]))
 getInfo name
   = withSession $ \hsc_env ->
-    do mb_stuff <- ioMsg $ tcRnGetInfo hsc_env name
+    do mb_stuff <- liftIO $ hscTcRnGetInfo hsc_env name
        case mb_stuff of
          Nothing -> return Nothing
          Just (thing, fixity, ispecs) -> do
@@ -886,7 +855,7 @@ getInfo name
            return (Just (thing, fixity, filter (plausible rdr_env) ispecs))
   where
     plausible rdr_env ispec    -- Dfun involving only names that are in ic_rn_glb_env
-       = all ok $ nameSetToList $ tyClsNamesOfType $ idType $ instanceDFunId ispec
+       = all ok $ nameSetToList $ orphNamesOfType $ idType $ instanceDFunId ispec
        where   -- A name is ok if it's in the rdr_env, 
                -- whether qualified or not
          ok n | n == name         = True       -- The one we looked for in the first place!
@@ -930,16 +899,8 @@ greToRdrNames GRE{ gre_name = name, gre_prov = prov }
 -- the identifier can refer to in the current interactive context.
 parseName :: GhcMonad m => String -> m [Name]
 parseName str = withSession $ \hsc_env -> do
-   (L _ rdr_name) <- hscParseIdentifier (hsc_dflags hsc_env) str
-   ioMsgMaybe $ tcRnLookupRdrName hsc_env rdr_name
-
--- | Returns the 'TyThing' for a 'Name'.  The 'Name' may refer to any
--- entity known to GHC, including 'Name's defined using 'runStmt'.
-lookupName :: GhcMonad m => Name -> m (Maybe TyThing)
-lookupName name = withSession $ \hsc_env -> do
-  mb_tything <- ioMsg $ tcRnLookupName hsc_env name
-  return mb_tything
-  -- XXX: calls panic in some circumstances;  is that ok?
+   (L _ rdr_name) <- liftIO $ hscParseIdentifier hsc_env str
+   liftIO $ hscTcRnLookupRdrName hsc_env rdr_name
 
 -- -----------------------------------------------------------------------------
 -- Getting the type of an expression
@@ -947,7 +908,7 @@ lookupName name = withSession $ \hsc_env -> do
 -- | Get the type of an expression
 exprType :: GhcMonad m => String -> m Type
 exprType expr = withSession $ \hsc_env -> do
-   ty <- hscTcExpr hsc_env expr
+   ty <- liftIO $ hscTcExpr hsc_env expr
    return $ tidyType emptyTidyEnv ty
 
 -- -----------------------------------------------------------------------------
@@ -956,14 +917,14 @@ exprType expr = withSession $ \hsc_env -> do
 -- | Get the kind of a  type
 typeKind  :: GhcMonad m => String -> m Kind
 typeKind str = withSession $ \hsc_env -> do
-   hscKcType hsc_env str
+   liftIO $ hscKcType hsc_env str
 
 -----------------------------------------------------------------------------
 -- cmCompileExpr: compile an expression and deliver an HValue
 
 compileExpr :: GhcMonad m => String -> m HValue
 compileExpr expr = withSession $ \hsc_env -> do
-  Just (ids, hval) <- hscStmt hsc_env ("let __cmCompileExpr = "++expr)
+  Just (ids, hval) <- liftIO $ hscStmt hsc_env ("let __cmCompileExpr = "++expr)
                 -- Run it!
   hvals <- liftIO (unsafeCoerce# hval :: IO [HValue])
 
@@ -976,14 +937,9 @@ compileExpr expr = withSession $ \hsc_env -> do
 
 dynCompileExpr :: GhcMonad m => String -> m Dynamic
 dynCompileExpr expr = do
-    (full,exports) <- getContext
-    setContext full $
-        (mkModule
-            (stringToPackageId "base") (mkModuleName "Data.Dynamic")
-        ,Nothing):exports
     let stmt = "let __dynCompileExpr = Data.Dynamic.toDyn (" ++ expr ++ ")"
-    Just (ids, hvals) <- withSession (flip hscStmt stmt)
-    setContext full exports
+    Just (ids, hvals) <- withSession $ \hsc_env -> 
+                           liftIO $ hscStmt hsc_env stmt
     vals <- liftIO (unsafeCoerce# hvals :: IO [Dynamic])
     case (ids,vals) of
         (_:[], v:[])    -> return v
@@ -1024,5 +980,7 @@ reconstructType hsc_env bound id = do
               hv <- Linker.getHValue hsc_env (varName id) 
               cvReconstructType hsc_env bound (idType id) hv
 
+mkRuntimeUnkTyVar :: Name -> Kind -> TyVar
+mkRuntimeUnkTyVar name kind = mkTcTyVar name kind RuntimeUnk
 #endif /* GHCI */