import GhciMonad
import GhciTags
+import Debugger
-- The GHC interface
import qualified GHC
import GHC ( Session, LoadHowMuch(..), Target(..), TargetId(..),
Type, Module, ModuleName, TyThing(..), Phase,
- BreakIndex, Name, SrcSpan )
-import Debugger
+ BreakIndex, Name, SrcSpan, Resume )
import DynFlags
import Packages
import PackageConfig
import Digraph
import BasicTypes hiding (isTopLevel)
import Panic hiding (showException)
-import FastString ( unpackFS )
import Config
import StaticFlags
import Linker
import Util
+import FastString
#ifndef mingw32_HOST_OS
import System.Posix
ghciWelcomeMsg =
" ___ ___ _\n"++
" / _ \\ /\\ /\\/ __(_)\n"++
- " / /_\\// /_/ / / | | GHC Interactive, version " ++ cProjectVersion ++ ", for Haskell 98.\n"++
- "/ /_\\\\/ __ / /___| | http://www.haskell.org/ghc/\n"++
- "\\____/\\/ /_/\\____/|_| Type :? for help.\n"
+ " / /_\\// /_/ / / | | GHC Interactive, version " ++ cProjectVersion ++ ", for Haskell 98.\n"++
+ "/ /_\\\\/ __ / /___| | http://www.haskell.org/ghc/\n"++
+ "\\____/\\/ /_/\\____/|_| Type :? for help.\n"
type Command = (String, String -> GHCi Bool, Bool, String -> IO [String])
cmdName (n,_,_,_) = n
-- Hugs users are accustomed to :e, so make sure it doesn't overlap
("?", keepGoing help, False, completeNone),
("add", keepGoingPaths addModule, False, completeFilename),
+ ("abandon", keepGoing abandonCmd, False, completeNone),
("break", keepGoing breakCmd, False, completeIdentifier),
("browse", keepGoing browseCmd, False, completeModule),
("cd", keepGoing changeDirectory, False, completeFilename),
("e", keepGoing editFile, False, completeFilename),
("edit", keepGoing editFile, False, completeFilename),
("etags", keepGoing createETagsFileCmd, False, completeFilename),
- ("force", keepGoing (pprintClosureCommand False True), False, completeIdentifier),
+ ("force", keepGoing forceCmd, False, completeIdentifier),
("help", keepGoing help, False, completeNone),
("info", keepGoing info, False, completeIdentifier),
("kind", keepGoing kindOfType, False, completeIdentifier),
("list", keepGoing listCmd, False, completeNone),
("module", keepGoing setContext, False, completeModule),
("main", keepGoing runMain, False, completeIdentifier),
- ("print", keepGoing (pprintClosureCommand True False), False, completeIdentifier),
+ ("print", keepGoing printCmd, False, completeIdentifier),
("quit", quit, False, completeNone),
("reload", keepGoing reloadModule, False, completeNone),
("set", keepGoing setCmd, True, completeSetOptions),
("show", keepGoing showCmd, False, completeNone),
- ("sprint", keepGoing (pprintClosureCommand False False),False, completeIdentifier),
+ ("sprint", keepGoing sprintCmd, False, completeIdentifier),
("step", stepCmd, False, completeIdentifier),
("type", keepGoing typeOfExpr, False, completeIdentifier),
("undef", keepGoing undefineMacro, False, completeMacro),
"\n" ++
" <stmt> evaluate/run <stmt>\n" ++
" :add <filename> ... add module(s) to the current target set\n" ++
+ " :abandon at a breakpoint, abandon current computation\n" ++
" :break [<mod>] <l> [<col>] set a breakpoint at the specified location\n" ++
" :break <name> set a breakpoint on the specified function\n" ++
" :browse [*]<module> display the names defined by <module>\n" ++
session = session,
options = [],
prelude = prel_mod,
- resume = [],
breaks = emptyActiveBreakPoints,
tickarrays = emptyModuleEnv
}
session <- getSession
(mod,imports) <- io (GHC.getContext session)
st <- getGHCiState
- when show_prompt (io (putStr (mkPrompt mod imports (resume st) (prompt st))))
+ resumes <- io $ GHC.getResumeContext session
+ when show_prompt (io (putStr (mkPrompt mod imports resumes (prompt st))))
l <- io (IO.try (hGetLine hdl))
case l of
Left e | isEOFError e -> return ()
f [] = empty
perc_s
- | (span,_,_):rest <- resumes
+ | eval:rest <- resumes
= (if not (null rest) then text "... " else empty)
- <> brackets (ppr span) <+> modules_prompt
+ <> brackets (ppr (GHC.resumeSpan eval)) <+> modules_prompt
| otherwise
= modules_prompt
io yield
saveSession -- for use by completion
st <- getGHCiState
- l <- io (readline (mkPrompt mod imports (resume st) (prompt st))
+ resumes <- io $ GHC.getResumeContext session
+ l <- io (readline (mkPrompt mod imports resumes (prompt st))
`finally` setNonBlockingFD 0)
-- readline sometimes puts stdin into blocking mode,
-- so we need to put it back for the IO library
where
doCommand (':' : command) = specialCommand command
doCommand stmt
- = do timeIt (do nms <- runStmt stmt; finishEvalExpr nms)
+ = do timeIt $ runStmt stmt
return False
-- This version is for the GHC command-line option -e. The only difference
doCommand (':' : command) = specialCommand command
doCommand stmt
- = do nms <- runStmt stmt
- case nms of
- Nothing -> io (exitWith (ExitFailure 1))
+ = do r <- runStmt stmt
+ case r of
+ False -> io (exitWith (ExitFailure 1))
-- failure to run the command causes exit(1) for ghc -e.
- _ -> do finishEvalExpr nms
- return True
+ _ -> return True
-runStmt :: String -> GHCi (Maybe (Bool,[Name]))
+runStmt :: String -> GHCi Bool
runStmt stmt
- | null (filter (not.isSpace) stmt) = return (Just (False,[]))
+ | null (filter (not.isSpace) stmt) = return False
| otherwise
= do st <- getGHCiState
session <- getSession
result <- io $ withProgName (progname st) $ withArgs (args st) $
GHC.runStmt session stmt
- switchOnRunResult result
+ afterRunStmt result
+ return False
+
+
+afterRunStmt :: GHC.RunResult -> GHCi (Maybe (Bool,[Name]))
+afterRunStmt run_result = do
+ mb_result <- switchOnRunResult run_result
+
+ -- possibly print the type and revert CAFs after evaluating an expression
+ show_types <- isOptionSet ShowType
+ session <- getSession
+ case mb_result of
+ Nothing -> return ()
+ Just (is_break,names) ->
+ when (is_break || show_types) $
+ mapM_ (showTypeOfName session) names
+
+ flushInterpBuffers
+ io installSignalHandlers
+ b <- isOptionSet RevertCAFs
+ io (when b revertCAFs)
+
+ return mb_result
+
switchOnRunResult :: GHC.RunResult -> GHCi (Maybe (Bool,[Name]))
switchOnRunResult GHC.RunFailed = return Nothing
switchOnRunResult (GHC.RunException e) = throw e
switchOnRunResult (GHC.RunOk names) = return $ Just (False,names)
-switchOnRunResult (GHC.RunBreak threadId names info resume) = do
+switchOnRunResult (GHC.RunBreak threadId names info) = do
session <- getSession
Just mod_info <- io $ GHC.getModuleInfo session (GHC.breakInfo_module info)
let modBreaks = GHC.modInfoModBreaks mod_info
let location = ticks ! GHC.breakInfo_number info
printForUser $ ptext SLIT("Stopped at") <+> ppr location
- pushResume location threadId resume
-
-- run the command set with ":set stop <cmd>"
st <- getGHCiState
runCommand (stop st)
return (Just (True,names))
--- possibly print the type and revert CAFs after evaluating an expression
-finishEvalExpr mb_names
- = do show_types <- isOptionSet ShowType
- session <- getSession
- case mb_names of
- Nothing -> return ()
- Just (is_break,names) ->
- when (is_break || show_types) $
- mapM_ (showTypeOfName session) names
-
- flushInterpBuffers
- io installSignalHandlers
- b <- isOptionSet RevertCAFs
- io (when b revertCAFs)
showTypeOfName :: Session -> Name -> GHCi ()
showTypeOfName session n
afterLoad ok session = do
io (revertCAFs) -- always revert CAFs on load.
- discardResumeContext
discardTickArrays
discardActiveBreakPoints
graph <- io (GHC.getModuleGraph session)
showContext :: GHCi ()
showContext = do
- st <- getGHCiState
- printForUser $ vcat (map pp_resume (resume st))
+ session <- getSession
+ resumes <- io $ GHC.getResumeContext session
+ printForUser $ vcat (map pp_resume (reverse resumes))
where
- pp_resume (span, _, _) = ptext SLIT("Stopped at") <+> ppr span
+ pp_resume resume =
+ ptext SLIT("--> ") <> text (GHC.resumeStmt resume)
+ $$ nest 2 (ptext SLIT("Stopped at") <+> ppr (GHC.resumeSpan resume))
+
-- -----------------------------------------------------------------------------
-- Completion
-- -----------------------------------------------------------------------------
-- commands for debugger
-foreign import ccall "rts_setStepFlag" setStepFlag :: IO ()
+sprintCmd = pprintCommand False False
+printCmd = pprintCommand True False
+forceCmd = pprintCommand False True
+
+pprintCommand bind force str = do
+ session <- getSession
+ io $ pprintClosureCommand session bind force str
stepCmd :: String -> GHCi Bool
-stepCmd [] = doContinue setStepFlag
+stepCmd [] = doContinue True
stepCmd expression = do
- io $ setStepFlag
runCommand expression
continueCmd :: String -> GHCi Bool
-continueCmd [] = doContinue $ return ()
+continueCmd [] = doContinue False
continueCmd other = do
io $ putStrLn "The continue command accepts no arguments."
return False
-doContinue :: IO () -> GHCi Bool
-doContinue actionBeforeCont = do
- resumeAction <- popResume
- case resumeAction of
- Nothing -> do
- io $ putStrLn "There is no computation running."
- return False
- Just (_,_,handle) -> do
- io $ actionBeforeCont
- session <- getSession
- runResult <- io $ GHC.resume session handle
- names <- switchOnRunResult runResult
- finishEvalExpr names
- return False
+doContinue :: Bool -> GHCi Bool
+doContinue step = do
+ session <- getSession
+ let resume | step = GHC.stepResume
+ | otherwise = GHC.resume
+ runResult <- io $ resume session
+ afterRunStmt runResult
+ return False
+
+abandonCmd :: String -> GHCi ()
+abandonCmd "" = do
+ s <- getSession
+ b <- io $ GHC.abandon s -- the prompt will change to indicate the new context
+ when (not b) $ io $ putStrLn "There is no computation running."
+ return ()
+abandonCmd _ = do
+ io $ putStrLn "The abandon command accepts no arguments."
deleteCmd :: String -> GHCi ()
deleteCmd argLine = do
else do
if GHC.isGoodSrcLoc loc
then findBreakAndSet (GHC.nameModule n) $
- findBreakByCoord (GHC.srcLocLine loc,
+ findBreakByCoord (Just (GHC.srcLocFile loc))
+ (GHC.srcLocLine loc,
GHC.srcLocCol loc)
else noCanDo $ text "can't find its location: " <>
ppr loc
breakByModuleLine mod line args
| [] <- args = findBreakAndSet mod $ findBreakByLine line
| [col] <- args, all isDigit col =
- findBreakAndSet mod $ findBreakByCoord (line, read col)
+ findBreakAndSet mod $ findBreakByCoord Nothing (line, read col)
| otherwise = io $ putStrLn "Invalid arguments to :break"
findBreakAndSet :: Module -> (TickArray -> Maybe (Int, SrcSpan)) -> GHCi ()
(complete,incomplete) = partition ends_here starts_here
where ends_here (nm,span) = GHC.srcSpanEndLine span == line
-findBreakByCoord :: (Int,Int) -> TickArray -> Maybe (BreakIndex,SrcSpan)
-findBreakByCoord (line, col) arr
+findBreakByCoord :: Maybe FastString -> (Int,Int) -> TickArray
+ -> Maybe (BreakIndex,SrcSpan)
+findBreakByCoord mb_file (line, col) arr
| not (inRange (bounds arr) line) = Nothing
| otherwise =
listToMaybe (sortBy rightmost contains)
ticks = arr ! line
-- the ticks that span this coordinate
- contains = [ tick | tick@(nm,span) <- ticks, span `spans` (line,col) ]
+ contains = [ tick | tick@(nm,span) <- ticks, span `spans` (line,col),
+ is_correct_file span ]
+
+ is_correct_file span
+ | Just f <- mb_file = GHC.srcSpanFile span == f
+ | otherwise = True
+
leftmost_smallest (_,a) (_,b) = a `compare` b
leftmost_largest (_,a) (_,b) = (GHC.srcSpanStart a `compare` GHC.srcSpanStart b)
listCmd :: String -> GHCi ()
listCmd str = do
- st <- getGHCiState
- case resume st of
+ session <- getSession
+ resumes <- io $ GHC.getResumeContext session
+ case resumes of
[] -> printForUser $ text "not stopped at a breakpoint; nothing to list"
- (span,_,_):_ -> io $ listAround span True
+ eval:_ -> io $ listAround (GHC.resumeSpan eval) True
-- | list a section of a source file around a particular SrcSpan.
-- If the highlight flag is True, also highlight the span using