import qualified GHC
import GHC ( Session, LoadHowMuch(..), Target(..), TargetId(..),
Type, Module, ModuleName, TyThing(..), Phase,
- BreakIndex, Name, SrcSpan )
+ 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
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
session <- getSession
io $ pprintClosureCommand session bind force str
-foreign import ccall "rts_setStepFlag" setStepFlag :: IO ()
-
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
- mb_res <- popResume
- case mb_res of
- Nothing -> do
- io $ putStrLn "There is no computation running."
- Just (span,_,_) ->
- return ()
- -- the prompt will change to indicate the new context
+ 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
projects / ghc-hetmet.git / blobdiff