Remove LazyUniqFM; fixes trac #3880

[ghc-hetmet.git] / compiler / main / InteractiveEval.hs

diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index 50eae9f..45519ff 100644 (file)
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -42,9 +42,9 @@ module InteractiveEval (
 import HscMain          hiding (compileExpr)
 import HscTypes
 import TcRnDriver
-import Type             hiding (typeKind)
-import TcType           hiding (typeKind)
 import InstEnv
+import Type
+import TcType          hiding( typeKind )
 import Var
 import Id
 import Name             hiding ( varName )
@@ -59,7 +59,7 @@ import Unique
 import UniqSupply
 import Module
 import Panic
-import LazyUniqFM
+import UniqFM
 import Maybes
 import ErrUtils
 import Util
@@ -82,7 +82,7 @@ import Data.Array
 import Exception
 import Control.Concurrent
 import Data.List (sortBy)
-import Foreign.StablePtr
+-- import Foreign.StablePtr
 import System.IO
 
 -- -----------------------------------------------------------------------------
@@ -308,7 +308,7 @@ traceRunStatus expr bindings final_ids
              let history' = mkHistory hsc_env apStack info `consBL` history
                 -- probably better make history strict here, otherwise
                 -- our BoundedList will be pointless.
-             liftIO $ evaluate history'
+             _ <- liftIO $ evaluate history'
              status <-
                  withBreakAction True (hsc_dflags hsc_env)
                                       breakMVar statusMVar $ do
@@ -586,7 +586,7 @@ bindLocalsAtBreakpoint hsc_env apStack (Just info) = do
    -- has been accidentally evaluated, or something else has gone wrong.
    -- So that we don't fall over in a heap when this happens, just don't
    -- bind any free variables instead, and we emit a warning.
-   mb_hValues <- mapM (getIdValFromApStack apStack) offsets
+   mb_hValues <- mapM (getIdValFromApStack apStack) (map fromIntegral offsets)
    let filtered_ids = [ id | (id, Just _hv) <- zip ids mb_hValues ]
    when (any isNothing mb_hValues) $
       debugTraceMsg (hsc_dflags hsc_env) 1 $
@@ -609,18 +609,22 @@ bindLocalsAtBreakpoint hsc_env apStack (Just info) = do
    --    - tidy the type variables
    --    - globalise the Id (Ids are supposed to be Global, apparently).
    --
-   let all_ids | isPointer result_id = result_id : new_ids
-               | otherwise           = new_ids
+   let result_ok = isPointer result_id
+                    && not (isUnboxedTupleType (idType result_id))
+
+       all_ids | result_ok = result_id : new_ids
+               | otherwise = new_ids
        (id_tys, tyvarss) = mapAndUnzip (skolemiseTy.idType) all_ids
        (_,tidy_tys) = tidyOpenTypes emptyTidyEnv id_tys
        new_tyvars = unionVarSets tyvarss             
-   let final_ids = zipWith setIdType all_ids tidy_tys
+       final_ids = zipWith setIdType all_ids tidy_tys
        ictxt0 = hsc_IC hsc_env
        ictxt1 = extendInteractiveContext ictxt0 final_ids new_tyvars
+
    Linker.extendLinkEnv [ (name,hval) | (name, Just hval) <- zip names mb_hValues ]
-   Linker.extendLinkEnv [(result_name, unsafeCoerce# apStack)]
+   when result_ok $ Linker.extendLinkEnv [(result_name, unsafeCoerce# apStack)]
    hsc_env1 <- rttiEnvironment hsc_env{ hsc_IC = ictxt1 }
-   return (hsc_env1, result_name:names, span)
+   return (hsc_env1, if result_ok then result_name:names else names, span)
   where
    mkNewId :: OccName -> Id -> IO Id
    mkNewId occ id = do