import qualified GHC
import GHC ( Session, LoadHowMuch(..), Target(..), TargetId(..),
Module, ModuleName, TyThing(..), Phase,
- BreakIndex, SrcSpan, Resume, SingleStep )
+ BreakIndex, SrcSpan, Resume, SingleStep, Id )
import PprTyThing
import DynFlags
printForUser $ ptext SLIT("Stopped at") <+>
ppr (GHC.resumeSpan $ head resumes)
-- printTypeOfNames session names
- printTypeAndContentOfNames session names
+ let namesSorted = sortBy compareNames names
+ tythings <- catMaybes `liftM`
+ io (mapM (GHC.lookupName session) namesSorted)
+
+ printTypeAndContents session [id | AnId id <- tythings]
maybe (return ()) runBreakCmd mb_info
-- run the command set with ":set stop <cmd>"
st <- getGHCiState
return (case run_result of GHC.RunOk _ -> True; _ -> False)
- where printTypeAndContentOfNames session names = do
- let namesSorted = sortBy compareNames names
- tythings <- catMaybes `liftM`
- io (mapM (GHC.lookupName session) namesSorted)
- let ids = [id | AnId id <- tythings]
- terms <- mapM (io . GHC.obtainTermB session 10 False) ids
- docs_terms <- mapM (io . showTerm session) terms
- dflags <- getDynFlags
- let pefas = dopt Opt_PrintExplicitForalls dflags
- printForUser $ vcat $ zipWith (\ty cts -> ty <+> equals <+> cts)
- (map (pprTyThing pefas . AnId) ids)
- docs_terms
-
runBreakCmd :: GHC.BreakInfo -> GHCi ()
runBreakCmd info = do
let mod = GHC.breakInfo_module info
Nothing -> return ()
Just thing -> printTyThing thing
+printTypeAndContents :: Session -> [Id] -> GHCi ()
+printTypeAndContents session ids = do
+ terms <- mapM (io . GHC.obtainTermB session 10 False) ids
+ docs_terms <- mapM (io . showTerm session) terms
+ dflags <- getDynFlags
+ let pefas = dopt Opt_PrintExplicitForalls dflags
+ printForUser $ vcat $ zipWith (\ty cts -> ty <+> equals <+> cts)
+ (map (pprTyThing pefas . AnId) ids)
+ docs_terms
+
+
specialCommand :: String -> GHCi Bool
specialCommand ('!':str) = shellEscape (dropWhile isSpace str)
specialCommand str = do
session <- getSession
io (mapM_ (GHC.addTarget session) targets)
ok <- io (GHC.load session LoadAllTargets)
- afterLoad ok session
+ afterLoad ok session Nothing
changeDirectory :: String -> GHCi ()
changeDirectory dir = do
-- as a ToDo for now.
io (GHC.setTargets session targets)
- doLoad session LoadAllTargets
+ doLoad session False LoadAllTargets
checkModule :: String -> GHCi ()
checkModule m = do
(text "global names: " <+> ppr global) $$
(text "local names: " <+> ppr local)
_ -> empty))
- afterLoad (successIf (isJust result)) session
+ afterLoad (successIf (isJust result)) session Nothing
reloadModule :: String -> GHCi ()
reloadModule m = do
session <- getSession
- doLoad session $ if null m then LoadAllTargets
- else LoadUpTo (GHC.mkModuleName m)
+ doLoad session True $ if null m then LoadAllTargets
+ else LoadUpTo (GHC.mkModuleName m)
return ()
-doLoad :: Session -> LoadHowMuch -> GHCi SuccessFlag
-doLoad session howmuch = do
+doLoad :: Session -> Bool -> LoadHowMuch -> GHCi SuccessFlag
+doLoad session retain_context howmuch = do
-- turn off breakpoints before we load: we can't turn them off later, because
-- the ModBreaks will have gone away.
discardActiveBreakPoints
+ context <- io $ GHC.getContext session
ok <- io (GHC.load session howmuch)
- afterLoad ok session
+ afterLoad ok session (if retain_context then Just context else Nothing)
return ok
-afterLoad :: SuccessFlag -> Session -> GHCi ()
-afterLoad ok session = do
+afterLoad :: SuccessFlag -> Session -> Maybe ([Module],[Module]) -> GHCi ()
+afterLoad ok session maybe_context = do
io (revertCAFs) -- always revert CAFs on load.
discardTickArrays
loaded_mods <- getLoadedModules session
- setContextAfterLoad session loaded_mods
+
+ -- try to retain the old module context for :reload. This might
+ -- not be possible, for example if some modules have gone away, so
+ -- we attempt to set the same context, backing off to the default
+ -- context if that fails.
+ case maybe_context of
+ Nothing -> setContextAfterLoad session loaded_mods
+ Just (as,bs) -> do
+ r <- io $ Exception.try (GHC.setContext session as bs)
+ case r of
+ Left _err -> setContextAfterLoad session loaded_mods
+ Right _ -> return ()
+
modulesLoadedMsg ok (map GHC.ms_mod_name loaded_mods)
setContextAfterLoad :: Session -> [GHC.ModSummary] -> GHCi ()
-> GHCi ([Module],[Module])
separate _ [] as bs = return (as,bs)
separate session (('*':str):ms) as bs = do
- m <- io $ GHC.findModule session (GHC.mkModuleName str) Nothing
- b <- io $ GHC.moduleIsInterpreted session m
- if b then separate session ms (m:as) bs
- else throwDyn (CmdLineError ("module '"
- ++ GHC.moduleNameString (GHC.moduleName m)
- ++ "' is not interpreted"))
+ m <- wantInterpretedModule str
+ separate session ms (m:as) bs
separate session (str:ms) as bs = do
- m <- io $ GHC.findModule session (GHC.mkModuleName str) Nothing
+ m <- lookupModule str
separate session ms as (m:bs)
newContext :: [String] -> GHCi ()
showBindings = do
s <- getSession
bindings <- io (GHC.getBindings s)
- mapM_ printTyThing $ sortBy compareTyThings bindings
- return ()
+ printTypeAndContents s [ id | AnId id <- sortBy compareTyThings bindings]
compareTyThings :: TyThing -> TyThing -> Ordering
t1 `compareTyThings` t2 = getName t1 `compareNames` getName t2