X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FInteractiveEval.hs;h=7467c2ea4fa4619d72fc9dcb5417911aeb4c5aee;hb=29d909009d47c52c5f02630658f7422c634230ab;hp=9c28c8410647cf5aea008bd6a63109e3b7af09d0;hpb=24ee75415832b05f53726f2bbdf52972b1cfb613;p=ghc-hetmet.git diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs index 9c28c84..7467c2e 100644 --- a/compiler/main/InteractiveEval.hs +++ b/compiler/main/InteractiveEval.hs @@ -13,10 +13,8 @@ module InteractiveEval ( resume, abandon, abandonAll, getResumeContext, - getHistoryTick, getHistorySpan, getHistoryModule, - findEnclosingDeclSpanByTick, back, forward, setContext, getContext, nameSetToGlobalRdrEnv, @@ -31,7 +29,7 @@ module InteractiveEval ( isModuleInterpreted, compileExpr, dynCompileExpr, lookupName, - obtainTerm, obtainTerm1, reconstructType, + Term(..), obtainTerm, obtainTerm1, obtainTermB, reconstructType, skolemiseSubst, skolemiseTy #endif ) where @@ -80,6 +78,7 @@ import GHC.Exts import Data.Array import Control.Exception as Exception import Control.Concurrent +import Data.List (sortBy) import Data.IORef import Foreign.StablePtr @@ -133,7 +132,7 @@ data History = History { historyApStack :: HValue, historyBreakInfo :: BreakInfo, - historyEnclosingDecl :: Name + historyEnclosingDecl :: Id -- ^^ A cache of the enclosing top level declaration, for convenience } @@ -144,9 +143,6 @@ mkHistory hsc_env hval bi = let (getHistorySpan hsc_env h) in h -getHistoryTick :: History -> BreakIndex -getHistoryTick = breakInfo_number . historyBreakInfo - getHistoryModule :: History -> Module getHistoryModule = breakInfo_module . historyBreakInfo @@ -159,26 +155,18 @@ getHistorySpan hsc_env hist = _ -> panic "getHistorySpan" -- | Finds the enclosing top level function name -findEnclosingDecl :: HscEnv -> Module -> SrcSpan -> Name +findEnclosingDecl :: HscEnv -> Module -> SrcSpan -> Id findEnclosingDecl hsc_env mod span = case lookupUFM (hsc_HPT hsc_env) (moduleName mod) of Nothing -> panic "findEnclosingDecl" Just hmi -> let - globals = typeEnvIds (md_types (hm_details hmi)) - Just decl = find (\n -> nameSrcSpan n < span) - (reverse $ map idName globals) - -- ^^ assumes md_types is sorted - in decl - --- | Finds the span of the (smallest) function containing this BreakIndex -findEnclosingDeclSpanByTick :: HscEnv -> Module -> BreakIndex -> SrcSpan -findEnclosingDeclSpanByTick hsc_env mod tick = - case lookupUFM (hsc_HPT hsc_env) (moduleName mod) of - Nothing -> panic "findEnclosingDecl" - Just hmi -> let - modbreaks = md_modBreaks (hm_details hmi) - in ASSERT (inRange (bounds modBreaks) tick) - modBreaks_decls modbreaks ! tick + globals = typeEnvIds (md_types (hm_details hmi)) + Just decl = + find (\id -> let n = idName id in + nameSrcSpan n < span && isExternalName n) + (reverse$ sortBy (compare `on` (nameSrcSpan.idName)) + globals) + in decl -- | Find the Module corresponding to a FilePath findModuleFromFile :: HscEnv -> FilePath -> Maybe Module @@ -922,12 +910,17 @@ isModuleInterpreted s mod_summary = withSession s $ \hsc_env -> obtainTerm1 :: HscEnv -> Bool -> Maybe Type -> a -> IO Term obtainTerm1 hsc_env force mb_ty x = - cvObtainTerm hsc_env force mb_ty (unsafeCoerce# x) + cvObtainTerm hsc_env maxBound force mb_ty (unsafeCoerce# x) + +obtainTermB :: HscEnv -> Int -> Bool -> Id -> IO Term +obtainTermB hsc_env bound force id = do + hv <- Linker.getHValue hsc_env (varName id) + cvObtainTerm hsc_env bound force (Just$ idType id) hv obtainTerm :: HscEnv -> Bool -> Id -> IO Term obtainTerm hsc_env force id = do hv <- Linker.getHValue hsc_env (varName id) - cvObtainTerm hsc_env force (Just$ idType id) hv + cvObtainTerm hsc_env maxBound force (Just$ idType id) hv -- Uses RTTI to reconstruct the type of an Id, making it less polymorphic reconstructType :: HscEnv -> Bool -> Id -> IO (Maybe Type)