+-- -----------------------------------------------------------------------------
+-- 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)
+
+extendEnvironment :: HscEnv -> a -> [(Id, Int)] -> IO (HscEnv, [Name])
+extendEnvironment hsc_env apStack idsOffsets = do
+ idsVals <- mapM (getIdValFromApStack apStack) idsOffsets
+ let (ids, hValues) = unzip idsVals
+ let names = map idName ids
+ let global_ids = map globaliseAndTidy ids
+ typed_ids <- mapM instantiateIdType global_ids
+ let ictxt = hsc_IC hsc_env
+ rn_env = ic_rn_local_env ictxt
+ type_env = ic_type_env ictxt
+ bound_names = map idName typed_ids
+ new_rn_env = extendLocalRdrEnv rn_env bound_names
+ -- Remove any shadowed bindings from the type_env;
+ -- they are inaccessible but might, I suppose, cause
+ -- a space leak if we leave them there
+ shadowed = [ n | name <- bound_names,
+ let rdr_name = mkRdrUnqual (nameOccName name),
+ Just n <- [lookupLocalRdrEnv rn_env rdr_name] ]
+ filtered_type_env = delListFromNameEnv type_env shadowed
+ new_type_env = extendTypeEnvWithIds filtered_type_env (typed_ids)
+ new_ic = ictxt { ic_rn_local_env = new_rn_env,
+ ic_type_env = new_type_env }
+ extendLinkEnv (zip names hValues) -- ToDo: we must remember to restore the old env after we finish a breakpoint
+ return (hsc_env{hsc_IC = new_ic}, names)
+ where
+ globaliseAndTidy :: Id -> Id
+ globaliseAndTidy id
+ = let tidied_type = tidyTopType$ idType id
+ in setIdType (globaliseId VanillaGlobal id) tidied_type
+
+ -- | Instantiate the tyVars with GHC.Base.Unknown
+ instantiateIdType :: Id -> IO Id
+ instantiateIdType id = do
+ instantiatedType <- instantiateTyVarsToUnknown hsc_env (idType id)
+ return$ setIdType id instantiatedType
+