From 77fc291cdb0cb1af5c42c20d48e1e39b0b5f328b Mon Sep 17 00:00:00 2001
From: Simon Marlow <simonmar@microsoft.com>
Date: Fri, 27 Apr 2007 14:20:36 +0000
Subject: [PATCH] Breakpoints: don't attempt to bind variables with unboxed
 types

---
 compiler/main/GHC.hs |   37 +++++++++++++++++++++----------------
 1 file changed, 21 insertions(+), 16 deletions(-)

diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index f1ab876..9c7dbaf 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -252,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
@@ -2309,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
@@ -2330,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
 
@@ -2350,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             
-- 
1.7.10.4