X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FGHC.hs;h=9c7dbafe02dff88fc8aa0d922ce72392a4319647;hb=77fc291cdb0cb1af5c42c20d48e1e39b0b5f328b;hp=ef19889e626ab3235d195c93e36e2cf299c4a734;hpb=97351f5d70e2d5797a092059cb205089d55dacc6;p=ghc-hetmet.git

diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index ef19889..9c7dbaf 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -194,7 +194,6 @@ module GHC (
 import RtClosureInspect ( cvObtainTerm, Term )
 import TcRnDriver	( tcRnLookupRdrName, tcRnGetInfo,
 			  tcRnLookupName, getModuleExports )
-import VarEnv		( emptyTidyEnv )
 import GHC.Exts         ( unsafeCoerce#, Ptr )
 import Foreign.StablePtr( deRefStablePtr, StablePtr, newStablePtr, freeStablePtr )
 import Foreign          ( poke )
@@ -253,11 +252,9 @@ import Util
 import StringBuffer	( StringBuffer, hGetStringBuffer )
 import Outputable
 import BasicTypes
-import TcType           ( tcSplitSigmaTy, isDictTy )
 import Maybes		( expectJust, mapCatMaybes )
 import HaddockParse
 import HaddockLex       ( tokenise )
-import PrelNames
 import Unique
 
 import Data.Array
@@ -2038,8 +2035,15 @@ getNamesInScope s = withSession s $ \hsc_env -> do
 
 getRdrNamesInScope :: Session -> IO [RdrName]
 getRdrNamesInScope  s = withSession s $ \hsc_env -> do
-  let env = ic_rn_gbl_env (hsc_IC hsc_env)
-  return (concat (map greToRdrNames (globalRdrEnvElts env)))
+  let 
+      ic = hsc_IC hsc_env
+      gbl_rdrenv = ic_rn_gbl_env ic
+      ids = typeEnvIds (ic_type_env ic)
+      gbl_names = concat (map greToRdrNames (globalRdrEnvElts gbl_rdrenv))
+      lcl_names = map (mkRdrUnqual.nameOccName.idName) ids
+  --
+  return (gbl_names ++ lcl_names)
+
 
 -- ToDo: move to RdrName
 greToRdrNames :: GlobalRdrElt -> [RdrName]
@@ -2303,17 +2307,17 @@ XXX the type of rts_evalStableIO no longer matches the above
 -- After stopping at a breakpoint, add free variables to the environment
 
 -- Todo: turn this into a primop, and provide special version(s) for unboxed things
-foreign import ccall "rts_getApStackVal" getApStackVal :: StablePtr a -> Int -> IO (StablePtr b)
-
-getIdValFromApStack :: a -> (Id, Int) -> IO (Id, HValue)
-getIdValFromApStack apStack (identifier, stackDepth) = do
-   -- ToDo: check the type of the identifer and decide whether it is unboxed or not
-   apSptr <- newStablePtr apStack
-   resultSptr <- getApStackVal apSptr (stackDepth - 1)
-   result <- deRefStablePtr resultSptr
-   freeStablePtr apSptr
-   freeStablePtr resultSptr 
-   return (identifier, unsafeCoerce# result)
+foreign import ccall unsafe "rts_getApStackVal" 
+        getApStackVal :: StablePtr a -> Int -> IO (StablePtr b)
+
+getIdValFromApStack :: a -> Int -> IO HValue
+getIdValFromApStack apStack stackDepth = do
+     apSptr <- newStablePtr apStack
+     resultSptr <- getApStackVal apSptr (stackDepth - 1)
+     result <- deRefStablePtr resultSptr
+     freeStablePtr apSptr
+     freeStablePtr resultSptr 
+     return (unsafeCoerce# result)
 
 extendEnvironment
         :: HscEnv
@@ -2324,8 +2328,14 @@ extendEnvironment
         -> [OccName]    -- names for the variables (from the source code)
         -> IO (HscEnv, [Name])
 extendEnvironment hsc_env apStack span idsOffsets result_ty occs = do
-   idsVals <- mapM (getIdValFromApStack apStack) idsOffsets 
-   let (ids, hValues) = unzip idsVals 
+
+   -- filter out any unboxed ids; we can't bind these at the prompt
+   let pointers = filter (\(id,_) -> isPointer id) idsOffsets
+       isPointer id | PtrRep <- idPrimRep id = True
+                    | otherwise              = False
+
+   let (ids, offsets) = unzip pointers
+   hValues <- mapM (getIdValFromApStack apStack) offsets
    new_ids <- zipWithM mkNewId occs ids
    let names = map idName ids
 
@@ -2344,7 +2354,8 @@ extendEnvironment hsc_env apStack span idsOffsets result_ty occs = do
    --    - tidy the type variables
    --    - globalise the Id (Ids are supposed to be Global, apparently).
    --
-   let all_ids = result_id : ids
+   let all_ids | isPointer result_id = result_id : ids
+               | otherwise           = ids
        (id_tys, tyvarss) = mapAndUnzip (skolemiseTy.idType) all_ids
        (_,tidy_tys) = tidyOpenTypes emptyTidyEnv id_tys
        new_tyvars = unionVarSets tyvarss