import Foreign.StablePtr ( newStablePtr )
import GHC.Exts ( unsafeCoerce# )
-import GHC.IOBase ( IOErrorType(InvalidArgument), IO(IO) )
+import GHC.IOBase ( IOErrorType(InvalidArgument) )
import Data.IORef ( IORef, readIORef, writeIORef )
import System.Posix.Internals ( setNonBlockingFD )
--- these are needed by the new ghci debugger
-import ByteCodeLink (HValue)
-import ByteCodeInstr (BreakInfo (..))
-import BreakArray
-
-----------------------------------------------------------------------------
ghciWelcomeMsg =
-- Hugs users are accustomed to :e, so make sure it doesn't overlap
("?", keepGoing help, False, completeNone),
("add", keepGoingPaths addModule, False, completeFilename),
- ("break", breakCmd, False, completeNone),
+ ("break", breakCmd, False, completeIdentifier),
("browse", keepGoing browseCmd, False, completeModule),
("cd", keepGoing changeDirectory, False, completeFilename),
("check", keepGoing checkModule, False, completeHomeModule),
- ("continue", continueCmd, False, completeNone),
+ ("continue", continueCmd, False, completeNone),
("ctags", keepGoing createCTagsFileCmd, False, completeFilename),
("def", keepGoing defineMacro, False, completeIdentifier),
- ("delete", deleteCmd, False, completeNone),
+ ("delete", deleteCmd, False, completeNone),
("e", keepGoing editFile, False, completeFilename),
("edit", keepGoing editFile, False, completeFilename),
("etags", keepGoing createETagsFileCmd, False, completeFilename),
("help", keepGoing help, False, completeNone),
("info", keepGoing info, False, completeIdentifier),
("kind", keepGoing kindOfType, False, completeIdentifier),
- ("load", keepGoingPaths loadModule_,False, completeHomeModuleOrFile),
+ ("load", keepGoingPaths loadModule_, False, completeHomeModuleOrFile),
("module", keepGoing setContext, False, completeModule),
("main", keepGoing runMain, False, completeIdentifier),
("print", keepGoing (pprintClosureCommand True False), False, completeIdentifier),
("set", keepGoing setCmd, True, completeSetOptions),
("show", keepGoing showCmd, False, completeNone),
("sprint", keepGoing (pprintClosureCommand False False),False, completeIdentifier),
- ("step", stepCmd, False, completeNone),
+ ("step", stepCmd, False, completeIdentifier),
("type", keepGoing typeOfExpr, False, completeIdentifier),
("undef", keepGoing undefineMacro, False, completeMacro),
("unset", keepGoing unsetOptions, True, completeSetOptions)
shortHelpText = "use :? for help.\n"
--- NOTE: spaces at the end of each line to workaround CPP/string gap bug.
helpText =
" Commands available from the prompt:\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" ++
" :cd <dir> change directory to <dir>\n" ++
+ " :continue resume after a breakpoint\n" ++
+ " :ctags [<file>] create tags file for Vi (default: \"tags\")\n" ++
" :def <cmd> <expr> define a command :<cmd>\n" ++
+ " :delete <number> delete the specified breakpoint\n" ++
+ " :delete * delete all breakpoints\n" ++
" :edit <file> edit file\n" ++
" :edit edit last module\n" ++
+ " :etags [<file>] create tags file for Emacs (default: \"TAGS\")\n" ++
+-- " :force <expr> print <expr>, forcing unevaluated parts\n" ++
" :help, :? display this list of commands\n" ++
" :info [<name> ...] display information about the given names\n" ++
- " :print [<name> ...] prints a value without forcing its computation\n" ++
- " :sprint [<name> ...] simplified version of :print\n" ++
+ " :kind <type> show the kind of <type>\n" ++
" :load <filename> ... load module(s) and their dependents\n" ++
" :module [+/-] [*]<mod> ... set the context for expression evaluation\n" ++
" :main [<arguments> ...] run the main function with the given arguments\n" ++
+ " :print [<name> ...] prints a value without forcing its computation\n" ++
+ " :quit exit GHCi\n" ++
" :reload reload the current module set\n" ++
"\n" ++
" :set <option> ... set options\n" ++
" :set prompt <prompt> set the prompt used in GHCi\n" ++
" :set editor <cmd> set the command used for :edit\n" ++
"\n" ++
+ " :show breaks show active breakpoints\n" ++
+ " :show context show the breakpoint context\n" ++
" :show modules show the currently loaded modules\n" ++
" :show bindings show the current bindings made at the prompt\n" ++
"\n" ++
- " :ctags [<file>] create tags file for Vi (default: \"tags\")\n" ++
- " :etags [<file>] create tags file for Emacs (default: \"TAGS\")\n" ++
+ " :sprint [<name> ...] simplifed version of :print\n" ++
+ " :step single-step after stopping at a breakpoint\n"++
+ " :step <expr> single-step into <expr>\n"++
" :type <expr> show the type of <expr>\n" ++
- " :kind <type> show the kind of <type>\n" ++
" :undef <cmd> undefine user-defined command :<cmd>\n" ++
" :unset <option> ... unset options\n" ++
- " :quit exit GHCi\n" ++
" :!<command> run the shell command <command>\n" ++
"\n" ++
" Options for ':set' and ':unset':\n" ++
["bindings"] -> showBindings
["linker"] -> io showLinkerState
["breaks"] -> showBkptTable
- _ -> throwDyn (CmdLineError "syntax: :show [modules|bindings]")
+ ["context"] -> showContext
+ _ -> throwDyn (CmdLineError "syntax: :show [modules|bindings|breaks]")
showModules = do
session <- getSession
activeBreaks <- getActiveBreakPoints
printForUser $ ppr activeBreaks
+showContext :: GHCi ()
+showContext = do
+ st <- getGHCiState
+ printForUser $ vcat (map pp_resume (resume st))
+ where
+ pp_resume (span, _, _) = ptext SLIT("Stopped at") <+> ppr span
+
-- -----------------------------------------------------------------------------
-- Completion
breakCmd argLine = do
session <- getSession
breakSwitch session $ words argLine
+ return False
-breakSwitch :: Session -> [String] -> GHCi Bool
+breakSwitch :: Session -> [String] -> GHCi ()
breakSwitch _session [] = do
io $ putStrLn "The break command requires at least one argument."
- return False
breakSwitch session args@(arg1:rest)
- | looksLikeModule arg1 = do
+ | looksLikeModuleName arg1 = do
mod <- wantInterpretedModule session arg1
- breakByModule mod rest
- return False
- | otherwise = do
+ breakByModule session mod rest
+ | all isDigit arg1 = do
(toplevel, _) <- io $ GHC.getContext session
case toplevel of
- (mod : _) -> breakByModule mod args
+ (mod : _) -> breakByModuleLine mod (read arg1) rest
[] -> do
io $ putStrLn "Cannot find default module for breakpoint."
io $ putStrLn "Perhaps no modules are loaded for debugging?"
- return False
- where
- -- Todo there may be a nicer way to test this
- looksLikeModule :: String -> Bool
- looksLikeModule [] = False
- looksLikeModule (x:_) = isUpper x
+ | otherwise = do -- assume it's a name
+ names <- io $ GHC.parseName session arg1
+ case names of
+ [] -> return ()
+ (n:_) -> do
+ let loc = nameSrcLoc n
+ modl = nameModule n
+ is_interpreted <- io (GHC.moduleIsInterpreted session modl)
+ if not is_interpreted
+ then noCanDo $ text "module " <> ppr modl <>
+ text " is not interpreted"
+ else do
+ if isGoodSrcLoc loc
+ then findBreakAndSet (nameModule n) $
+ findBreakByCoord (srcLocLine loc, srcLocCol loc)
+ else noCanDo $ text "can't find its location: " <>
+ ppr loc
+ where
+ noCanDo why = printForUser $
+ text "cannot set breakpoint on " <> ppr n <> text ": " <> why
+
wantInterpretedModule :: Session -> String -> GHCi Module
wantInterpretedModule session str = do
throwDyn (CmdLineError ("module '" ++ str ++ "' is not interpreted"))
return modl
-breakByModule :: Module -> [String] -> GHCi ()
-breakByModule mod args@(arg1:rest)
+breakByModule :: Session -> Module -> [String] -> GHCi ()
+breakByModule session mod args@(arg1:rest)
| all isDigit arg1 = do -- looks like a line number
breakByModuleLine mod (read arg1) rest
- | looksLikeVar arg1 = do
- -- break by a function definition
- io $ putStrLn "Break by function definition not implemented."
- | otherwise = io $ putStrLn "Invalid arguments to break command."
- where
- -- Todo there may be a nicer way to test this
- looksLikeVar :: String -> Bool
- looksLikeVar [] = False
- looksLikeVar (x:_) = isLower x || x `elem` "~!@#$%^&*-+"
+ | otherwise = io $ putStrLn "Invalid arguments to :break"
breakByModuleLine :: Module -> Int -> [String] -> GHCi ()
breakByModuleLine mod line args
| [] <- args = findBreakAndSet mod $ findBreakByLine line
| [col] <- args, all isDigit col =
findBreakAndSet mod $ findBreakByCoord (line, read col)
- | otherwise = io $ putStrLn "Invalid arguments to break command."
+ | otherwise = io $ putStrLn "Invalid arguments to :break"
findBreakAndSet :: Module -> (TickArray -> Maybe (Int, SrcSpan)) -> GHCi ()
findBreakAndSet mod lookupTickTree = do
-- - the rightmost subexpression enclosing the specified line
--
findBreakByLine :: Int -> TickArray -> Maybe (BreakIndex,SrcSpan)
-findBreakByLine line arr =
- listToMaybe (sortBy leftmost complete) `mplus`
- listToMaybe (sortBy leftmost incomplete) `mplus`
- listToMaybe (sortBy rightmost ticks)
+findBreakByLine line arr
+ | not (inRange (bounds arr) line) = Nothing
+ | otherwise =
+ listToMaybe (sortBy leftmost complete) `mplus`
+ listToMaybe (sortBy leftmost incomplete) `mplus`
+ listToMaybe (sortBy rightmost ticks)
where
ticks = arr ! line
where ends_here (nm,span) = srcSpanEndLine span == line
findBreakByCoord :: (Int,Int) -> TickArray -> Maybe (BreakIndex,SrcSpan)
-findBreakByCoord (line, col) arr =
- listToMaybe (sortBy rightmost contains)
+findBreakByCoord (line, col) arr
+ | not (inRange (bounds arr) line) = Nothing
+ | otherwise =
+ listToMaybe (sortBy rightmost contains)
where
ticks = arr ! line
max_line = maximum (map srcSpanEndLine (map snd ticks))
srcSpanLines span = [ srcSpanStartLine span .. srcSpanEndLine span ]
-getModBreak :: Module -> GHCi (BreakArray, Array Int SrcSpan)
+getModBreak :: Module -> GHCi (GHC.BreakArray, Array Int SrcSpan)
getModBreak mod = do
session <- getSession
Just mod_info <- io $ GHC.getModuleInfo session mod
lookupModule session modName
= io (GHC.findModule session (GHC.mkModuleName modName) Nothing)
-setBreakFlag :: Bool -> BreakArray -> Int -> IO Bool
+setBreakFlag :: Bool -> GHC.BreakArray -> Int -> IO Bool
setBreakFlag toggle array index
- | toggle = setBreakOn array index
- | otherwise = setBreakOff array index
+ | toggle = GHC.setBreakOn array index
+ | otherwise = GHC.setBreakOff array index
{- these should probably go to the GHC API at some point -}
projects / ghc-hetmet.git / blobdiff