Fix segfault in array copy primops on 32-bit

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

diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index 8967c17..bb5fab6 100644 (file)
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -9,7 +9,8 @@
 module InteractiveEval (
 #ifdef GHCI
         RunResult(..), Status(..), Resume(..), History(..),
-       runStmt, parseImportDecl, SingleStep(..),
+       runStmt, runStmtWithLocation,
+        parseImportDecl, SingleStep(..),
         resume,
         abandon, abandonAll,
         getResumeContext,
@@ -39,10 +40,9 @@ module InteractiveEval (
 
 import GhcMonad
 import HscMain
-import HsSyn (ImportDecl)
+import HsSyn
 import HscTypes
-import TcRnDriver
-import RnNames         (gresFromAvails)
+import RnNames          (gresFromAvails)
 import InstEnv
 import Type
 import TcType          hiding( typeKind )
@@ -67,14 +67,13 @@ import ErrUtils
 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 hiding (unsafePerformIO)
 import Foreign.C
@@ -180,7 +179,13 @@ findEnclosingDecls hsc_env 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
 
@@ -192,7 +197,7 @@ runStmt expr step =
     let dflags'  = dopt_unset (hsc_dflags hsc_env) Opt_WarnUnusedBinds
         hsc_env' = hsc_env{ hsc_dflags = dflags' }
 
-    r <- liftIO $ hscStmt hsc_env' expr
+    r <- liftIO $ hscStmtWithLocation hsc_env' expr source linenumber
 
     case r of
       Nothing -> return RunFailed -- empty statement / comment
@@ -772,37 +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 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
@@ -830,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.
@@ -860,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!
@@ -942,15 +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 $ \hsc_env -> 
                            liftIO $ hscStmt hsc_env stmt
-    setContext full exports
     vals <- liftIO (unsafeCoerce# hvals :: IO [Dynamic])
     case (ids,vals) of
         (_:[], v:[])    -> return v