X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2Fghci%2FLinker.lhs;h=f06a728b9944aa2daa6273e1cb8d44eca286cc38;hb=84923cc7de2a93c22a2f72daf9ac863959efae13;hp=6073d6fcb808503dae498107fccf9b03be3d3ef9;hpb=ab5b8aa357c685a7c702262903bce04c66f79156;p=ghc-hetmet.git diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs index 6073d6f..f06a728 100644 --- a/compiler/ghci/Linker.lhs +++ b/compiler/ghci/Linker.lhs @@ -14,11 +14,11 @@ necessary. \begin{code} {-# OPTIONS -optc-DNON_POSIX_SOURCE -#include "Linker.h" #-} -module Linker ( HValue, showLinkerState, +module Linker ( HValue, getHValue, showLinkerState, linkExpr, unload, extendLinkEnv, withExtendedLinkEnv, extendLoadedPkgs, - linkPackages,initDynLinker - ,recoverDataCon + linkPackages,initDynLinker, + recoverDataCon ) where #include "HsVersions.h" @@ -28,7 +28,6 @@ import ByteCodeLink import ByteCodeItbls import ByteCodeAsm import RtClosureInspect -import Var import IfaceEnv import Config import OccName @@ -63,7 +62,6 @@ import Control.Arrow ( second ) import Data.IORef import Data.List import Foreign.Ptr -import GHC.Exts import System.IO import System.Directory @@ -195,12 +193,16 @@ recoverDCInRTS a = do helper [] = Nothing helper x = Just . second (drop 1) . break (==delim) $ x in unfoldr helper - -removeLeadingUnderscore = if cLeadingUnderscore=="YES" + removeLeadingUnderscore = if cLeadingUnderscore=="YES" then tail else id - +getHValue :: Name -> IO (Maybe HValue) +getHValue name = do + pls <- readIORef v_PersistentLinkerState + case lookupNameEnv (closure_env pls) name of + Just (_,x) -> return$ Just x + _ -> return Nothing withExtendedLinkEnv :: [(Name,HValue)] -> IO a -> IO a withExtendedLinkEnv new_env action @@ -726,7 +728,7 @@ linkSomeBCOs toplevs_only ie ce_in de_in ul_bcos let de_additions = [(address, name) | (address, name) <- zip addresses names , not(address `elemAddressEnv` de_in) ] - de_out = extendAddressEnvList' de_in de_additions + de_out = extendAddressEnvList de_in de_additions return ( ce_out, de_out, hvals) where goForRefs = getRefs []