abandon, abandonAll,
getResumeContext,
getHistorySpan,
+ getHistoryModule,
back, forward,
setContext, getContext,
nameSetToGlobalRdrEnv,
isModuleInterpreted,
compileExpr, dynCompileExpr,
lookupName,
- obtainTerm, obtainTerm1, reconstructType,
+ Term(..), obtainTerm, obtainTerm1, obtainTermB, reconstructType,
skolemiseSubst, skolemiseTy
#endif
) where
import Outputable
import Data.Dynamic
+import Data.List (find)
import Control.Monad
import Foreign
import Foreign.C
import Data.Array
import Control.Exception as Exception
import Control.Concurrent
+import Data.List (sortBy)
import Data.IORef
import Foreign.StablePtr
data History
= History {
historyApStack :: HValue,
- historyBreakInfo :: BreakInfo
+ historyBreakInfo :: BreakInfo,
+ historyEnclosingDecl :: Id
+ -- ^^ A cache of the enclosing top level declaration, for convenience
}
-getHistorySpan :: Session -> History -> IO SrcSpan
-getHistorySpan s hist = withSession s $ \hsc_env -> do
- let inf = historyBreakInfo hist
+mkHistory :: HscEnv -> HValue -> BreakInfo -> History
+mkHistory hsc_env hval bi = let
+ h = History hval bi decl
+ decl = findEnclosingDecl hsc_env (getHistoryModule h)
+ (getHistorySpan hsc_env h)
+ in h
+
+getHistoryModule :: History -> Module
+getHistoryModule = breakInfo_module . historyBreakInfo
+
+getHistorySpan :: HscEnv -> History -> SrcSpan
+getHistorySpan hsc_env hist =
+ let inf = historyBreakInfo hist
num = breakInfo_number inf
- case lookupUFM (hsc_HPT hsc_env) (moduleName (breakInfo_module inf)) of
- Just hmi -> return (modBreaks_locs (md_modBreaks (hm_details hmi)) ! num)
+ in case lookupUFM (hsc_HPT hsc_env) (moduleName (breakInfo_module inf)) of
+ Just hmi -> modBreaks_locs (md_modBreaks (hm_details hmi)) ! num
_ -> panic "getHistorySpan"
+-- | Finds the enclosing top level function 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 (\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
+findModuleFromFile hsc_env fp =
+ listToMaybe $ [ms_mod ms | ms <- hsc_mod_graph hsc_env
+ , ml_hs_file(ms_location ms) == Just (read fp)]
+
+
-- | Run a statement in the current interactive context. Statement
-- may bind multple values.
runStmt :: Session -> String -> SingleStep -> IO RunResult
if b
then handle_normally
else do
- let history' = consBL (History apStack info) history
+ let history' = mkHistory hsc_env apStack info `consBL` history
-- probably better make history strict here, otherwise
-- our BoundedList will be pointless.
evaluate history'
when (isStep step) $ setStepFlag
case r of
Resume expr tid breakMVar statusMVar bindings
- final_ids apStack info _ _ _ -> do
+ final_ids apStack info _ hist _ -> do
withBreakAction (isStep step) (hsc_dflags hsc_env)
breakMVar statusMVar $ do
status <- withInterruptsSentTo
-- this awakens the stopped thread...
return tid)
(takeMVar statusMVar)
- -- and wait for the result
+ -- and wait for the result
+ let hist' =
+ case info of
+ Nothing -> fromListBL 50 hist
+ Just i -> mkHistory hsc_env apStack i `consBL`
+ fromListBL 50 hist
case step of
RunAndLogSteps ->
traceRunStatus expr ref bindings final_ids
- breakMVar statusMVar status emptyHistory
+ breakMVar statusMVar status hist'
_other ->
handleRunStatus expr ref bindings final_ids
- breakMVar statusMVar status emptyHistory
+ breakMVar statusMVar status hist'
back :: Session -> IO ([Name], Int, SrcSpan)
resumeBreakInfo = mb_info } ->
update_ic apStack mb_info
else case history !! (new_ix - 1) of
- History apStack info ->
+ History apStack info _ ->
update_ic apStack (Just info)
-- -----------------------------------------------------------------------------
toListBL (BL _ _ left right) = left ++ reverse right
+fromListBL bound l = BL (length l) bound l []
+
-- lenBL (BL len _ _ _) = len
-- -----------------------------------------------------------------------------
_not_a_home_module -> return False
-- | Looks up an identifier in the current interactive context (for :info)
+-- Filter the instances by the ones whose tycons (or clases resp)
+-- are in scope (qualified or otherwise). Otherwise we list a whole lot too many!
+-- The exact choice of which ones to show, and which to hide, is a judgement call.
+-- (see Trac #1581)
getInfo :: Session -> Name -> IO (Maybe (TyThing,Fixity,[Instance]))
-getInfo s name = withSession s $ \hsc_env -> tcRnGetInfo hsc_env name
+getInfo s name
+ = withSession s $ \hsc_env ->
+ do { mb_stuff <- tcRnGetInfo hsc_env name
+ ; case mb_stuff of
+ Nothing -> return Nothing
+ Just (thing, fixity, ispecs) -> do
+ { let rdr_env = ic_rn_gbl_env (hsc_IC hsc_env)
+ ; return (Just (thing, fixity, filter (plausible rdr_env) ispecs)) } }
+ where
+ plausible rdr_env ispec -- Dfun involving only names that are in ic_rn_glb_env
+ = all ok $ nameSetToList $ tyClsNamesOfType $ idType $ instanceDFunId ispec
+ where -- A name is ok if it's in the rdr_env,
+ -- whether qualified or not
+ ok n | n == name = True -- The one we looked for in the first place!
+ | isBuiltInSyntax n = True
+ | isExternalName n = any ((== n) . gre_name)
+ (lookupGRE_Name rdr_env n)
+ | otherwise = True
-- | Returns all names in scope in the current interactive context
getNamesInScope :: Session -> IO [Name]
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)