-- The GHC interface
import qualified GHC
import GHC ( Session, LoadHowMuch(..), Target(..), TargetId(..),
Type, Module, ModuleName, TyThing(..), Phase,
BreakIndex, Name, SrcSpan )
-- The GHC interface
import qualified GHC
import GHC ( Session, LoadHowMuch(..), Target(..), TargetId(..),
Type, Module, ModuleName, TyThing(..), Phase,
BreakIndex, Name, SrcSpan )
- " / /_\\// /_/ / / | | 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
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),
-- Hugs users are accustomed to :e, so make sure it doesn't overlap
("?", keepGoing help, False, completeNone),
("add", keepGoingPaths addModule, False, completeFilename),
("break", keepGoing breakCmd, False, completeIdentifier),
("browse", keepGoing browseCmd, False, completeModule),
("cd", keepGoing changeDirectory, False, completeFilename),
("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),
("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),
("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),
("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),
("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),
("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" ++
"\n" ++
" <stmt> evaluate/run <stmt>\n" ++
" :add <filename> ... add module(s) to the current target set\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" ++
" :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" ++
-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 :: String -> GHC.RunResult -> GHCi (Maybe (Bool,[Name]))
+switchOnRunResult stmt GHC.RunFailed = return Nothing
+switchOnRunResult stmt (GHC.RunException e) = throw e
+switchOnRunResult stmt (GHC.RunOk names) = return $ Just (False,names)
+switchOnRunResult stmt (GHC.RunBreak threadId names info resume) = do
session <- getSession
Just mod_info <- io $ GHC.getModuleInfo session (GHC.breakInfo_module info)
let modBreaks = GHC.modInfoModBreaks mod_info
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
let location = ticks ! GHC.breakInfo_number info
printForUser $ ptext SLIT("Stopped at") <+> ppr location
- pushResume location threadId resume
+ pushResume EvalInProgress{ evalStmt = stmt,
+ evalSpan = location,
+ evalThreadId = threadId,
+ evalResumeHandle = resume }
+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
+
breakByModuleLine mod line args
| [] <- args = findBreakAndSet mod $ findBreakByLine line
| [col] <- args, all isDigit col =
breakByModuleLine mod line args
| [] <- args = findBreakAndSet mod $ findBreakByLine line
| [col] <- args, all isDigit col =
| otherwise = io $ putStrLn "Invalid arguments to :break"
findBreakAndSet :: Module -> (TickArray -> Maybe (Int, SrcSpan)) -> GHCi ()
| 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
(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
- 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)
leftmost_smallest (_,a) (_,b) = a `compare` b
leftmost_largest (_,a) (_,b) = (GHC.srcSpanStart a `compare` GHC.srcSpanStart b)
-- | list a section of a source file around a particular SrcSpan.
-- If the highlight flag is True, also highlight the span using
-- | list a section of a source file around a particular SrcSpan.
-- If the highlight flag is True, also highlight the span using