import Data.Dynamic
import Data.Array
import Control.Monad as Monad
+import Text.Printf
import Foreign.StablePtr ( newStablePtr )
import GHC.Exts ( unsafeCoerce# )
("browse", keepGoing browseCmd, False, completeModule),
("cd", keepGoing changeDirectory, False, completeFilename),
("check", keepGoing checkModule, False, completeHomeModule),
- ("continue", continueCmd, False, completeNone),
+ ("continue", keepGoing continueCmd, False, completeNone),
("ctags", keepGoing createCTagsFileCmd, False, completeFilename),
("def", keepGoing defineMacro, False, completeIdentifier),
("delete", keepGoing deleteCmd, False, completeNone),
("set", keepGoing setCmd, True, completeSetOptions),
("show", keepGoing showCmd, False, completeNone),
("sprint", keepGoing sprintCmd, False, completeIdentifier),
- ("step", stepCmd, False, completeIdentifier),
+ ("step", keepGoing stepCmd, False, completeIdentifier),
("type", keepGoing typeOfExpr, False, completeIdentifier),
- ("trace", traceCmd, False, completeIdentifier),
+ ("trace", keepGoing traceCmd, False, completeIdentifier),
("undef", keepGoing undefineMacro, False, completeMacro),
("unset", keepGoing unsetOptions, True, completeSetOptions)
]
helpText =
" Commands available from the prompt:\n" ++
"\n" ++
- " <stmt> evaluate/run <stmt>\n" ++
+ " <statement> evaluate/run <statement>\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" ++
" :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" ++
" :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" ++
+ " :type <expr> show the type of <expr>\n" ++
+ " :undef <cmd> undefine user-defined command :<cmd>\n" ++
+ " :!<command> run the shell command <command>\n" ++
+ "\n" ++
+ " -- Commands for debugging:\n" ++
+ "\n" ++
+ " :abandon at a breakpoint, abandon current computation\n" ++
+ " :back go back in the history (after :trace)\n" ++
+ " :break [<mod>] <l> [<col>] set a breakpoint at the specified location\n" ++
+ " :break <name> set a breakpoint on the specified function\n" ++
+ " :continue resume after a breakpoint\n" ++
+ " :delete <number> delete the specified breakpoint\n" ++
+ " :delete * delete all breakpoints\n" ++
+ " :force <expr> print <expr>, forcing unevaluated parts\n" ++
+ " :forward go forward in the history (after :back)\n" ++
+ " :history [<n>] show the last <n> items in the history (after :trace)\n" ++
+ " :print [<name> ...] prints a value without forcing its computation\n" ++
+ " :step single-step after stopping at a breakpoint\n"++
+ " :step <expr> single-step into <expr>\n"++
+ " :trace trace after stopping at a breakpoint\n"++
+ " :trace <expr> trace into <expr> (remembers breakpoints for :history)\n"++
+ " :sprint [<name> ...] simplifed version of :print\n" ++
+
+ "\n" ++
+ " -- Commands for changing settings:\n" ++
"\n" ++
" :set <option> ... set options\n" ++
" :set args <arg> ... set the arguments returned by System.getArgs\n" ++
" :set prompt <prompt> set the prompt used in GHCi\n" ++
" :set editor <cmd> set the command used for :edit\n" ++
" :set stop <cmd> set the command to run when a breakpoint is hit\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" ++
- " :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" ++
- " :undef <cmd> undefine user-defined command :<cmd>\n" ++
" :unset <option> ... unset options\n" ++
- " :!<command> run the shell command <command>\n" ++
"\n" ++
- " Options for ':set' and ':unset':\n" ++
+ " Options for ':set' and ':unset':\n" ++
"\n" ++
" +r revert top-level expressions after each evaluation\n" ++
" +s print timing/memory stats after each evaluation\n" ++
" +t print type after evaluation\n" ++
" -<flags> most GHC command line flags can also be set here\n" ++
" (eg. -v2, -fglasgow-exts, etc.)\n" ++
+ "\n" ++
+ " -- Commands for displaying information:\n" ++
+ "\n" ++
+ " :show bindings show the current bindings made at the prompt\n" ++
+ " :show breaks show the active breakpoints\n" ++
+ " :show context show the breakpoint context\n" ++
+ " :show modules show the currently loaded modules\n" ++
+ " :show <setting> show anything that can be set with :set (e.g. args)\n" ++
"\n"
--- Todo: add help for breakpoint commands here
findEditor = do
getEnv "EDITOR"
result <- io $ withProgName (progname st) $ withArgs (args st) $
GHC.runStmt session stmt step
afterRunStmt result
- return False
-afterRunStmt :: GHC.RunResult -> GHCi (Maybe (Bool,[Name]))
+afterRunStmt :: GHC.RunResult -> GHCi Bool
+ -- False <=> the statement failed to compile
+afterRunStmt (GHC.RunException e) = throw e
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
-
+ case run_result of
+ GHC.RunOk names -> do
+ show_types <- isOptionSet ShowType
+ when show_types $ mapM_ (showTypeOfName session) names
+ GHC.RunBreak _ names _ -> do
+ resumes <- io $ GHC.getResumeContext session
+ printForUser $ ptext SLIT("Stopped at") <+>
+ ppr (GHC.resumeSpan (head resumes))
+ mapM_ (showTypeOfName session) names
+ -- run the command set with ":set stop <cmd>"
+ st <- getGHCiState
+ runCommand (stop st)
+ return ()
+ _ -> return ()
+
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) = do
- session <- getSession
- Just mod_info <- io $ GHC.getModuleInfo session (GHC.breakInfo_module info)
- let modBreaks = GHC.modInfoModBreaks mod_info
- let ticks = GHC.modBreaks_locs modBreaks
-
- -- display information about the breakpoint
- let location = ticks ! GHC.breakInfo_number info
- printForUser $ ptext SLIT("Stopped at") <+> ppr location
-
- -- run the command set with ":set stop <cmd>"
- st <- getGHCiState
- runCommand (stop st)
-
- return (Just (True,names))
+ return (case run_result of GHC.RunOk _ -> True; _ -> False)
showTypeOfName :: Session -> Name -> GHCi ()
session <- getSession
-- unload first
+ discardActiveBreakPoints
io (GHC.setTargets session [])
io (GHC.load session LoadAllTargets)
-- as a ToDo for now.
io (GHC.setTargets session targets)
- ok <- io (GHC.load session LoadAllTargets)
- afterLoad ok session
- return ok
+ doLoad session LoadAllTargets
checkModule :: String -> GHCi ()
checkModule m = do
reloadModule :: String -> GHCi ()
reloadModule "" = do
io (revertCAFs) -- always revert CAFs on reload.
+ discardActiveBreakPoints
session <- getSession
- ok <- io (GHC.load session LoadAllTargets)
- afterLoad ok session
+ doLoad session LoadAllTargets
+ return ()
reloadModule m = do
io (revertCAFs) -- always revert CAFs on reload.
+ discardActiveBreakPoints
session <- getSession
- ok <- io (GHC.load session (LoadUpTo (GHC.mkModuleName m)))
+ doLoad session (LoadUpTo (GHC.mkModuleName m))
+ return ()
+
+doLoad session howmuch = do
+ -- turn off breakpoints before we load: we can't turn them off later, because
+ -- the ModBreaks will have gone away.
+ discardActiveBreakPoints
+ ok <- io (GHC.load session howmuch)
afterLoad ok session
+ return ok
afterLoad ok session = do
io (revertCAFs) -- always revert CAFs on load.
discardTickArrays
- discardActiveBreakPoints
graph <- io (GHC.getModuleGraph session)
graph' <- filterM (io . GHC.isLoaded session . GHC.ms_mod_name) graph
setContextAfterLoad session graph'
do -- first, deal with the GHCi opts (+s, +t, etc.)
let (plus_opts, minus_opts) = partition isPlus wds
mapM_ setOpt plus_opts
-
-- then, dynamic flags
+ newDynFlags minus_opts
+
+newDynFlags minus_opts = do
dflags <- getDynFlags
let pkg_flags = packageFlags dflags
(dflags',leftovers) <- io $ GHC.parseDynamicFlags dflags minus_opts
mapM_ unsetOpt plus_opts
- -- can't do GHC flags for now
- if (not (null minus_opts))
- then throwDyn (CmdLineError "can't unset GHC command-line flags")
- else return ()
+ let no_flag ('-':'f':rest) = return ("-fno-" ++ rest)
+ no_flag f = throwDyn (ProgramError ("don't know how to reverse " ++ f))
+
+ no_flags <- mapM no_flag minus_opts
+ newDynFlags no_flags
isMinus ('-':s) = True
isMinus _ = False
-- ---------------------------------------------------------------------------
-- code for `:show'
-showCmd str =
+showCmd str = do
+ st <- getGHCiState
case words str of
+ ["args"] -> io $ putStrLn (show (args st))
+ ["prog"] -> io $ putStrLn (show (progname st))
+ ["prompt"] -> io $ putStrLn (show (prompt st))
+ ["editor"] -> io $ putStrLn (show (editor st))
+ ["stop"] -> io $ putStrLn (show (stop st))
["modules" ] -> showModules
["bindings"] -> showBindings
["linker"] -> io showLinkerState
- ["breaks"] -> showBkptTable
- ["context"] -> showContext
- _ -> throwDyn (CmdLineError "syntax: :show [modules|bindings|breaks]")
+ ["breaks"] -> showBkptTable
+ ["context"] -> showContext
+ _ -> throwDyn (CmdLineError "syntax: :show [args|prog|prompt|editor|stop|modules|bindings|breaks|context]")
showModules = do
session <- getSession
session <- getSession
io $ pprintClosureCommand session bind force str
-stepCmd :: String -> GHCi Bool
+stepCmd :: String -> GHCi ()
stepCmd [] = doContinue GHC.SingleStep
-stepCmd expression = runStmt expression GHC.SingleStep
+stepCmd expression = do runStmt expression GHC.SingleStep; return ()
-traceCmd :: String -> GHCi Bool
+traceCmd :: String -> GHCi ()
traceCmd [] = doContinue GHC.RunAndLogSteps
-traceCmd expression = runStmt expression GHC.RunAndLogSteps
+traceCmd expression = do runStmt expression GHC.RunAndLogSteps; return ()
-continueCmd :: String -> GHCi Bool
-continueCmd [] = doContinue GHC.RunToCompletion
-continueCmd other = do
- io $ putStrLn "The continue command accepts no arguments."
- return False
+continueCmd :: String -> GHCi ()
+continueCmd = noArgs $ doContinue GHC.RunToCompletion
-doContinue :: SingleStep -> GHCi Bool
+doContinue :: SingleStep -> GHCi ()
doContinue step = do
session <- getSession
runResult <- io $ GHC.resume session step
afterRunStmt runResult
- return False
+ return ()
abandonCmd :: String -> GHCi ()
abandonCmd = noArgs $ do
| otherwise = return ()
historyCmd :: String -> GHCi ()
-historyCmd = noArgs $ do
- s <- getSession
- resumes <- io $ GHC.getResumeContext s
- case resumes of
- [] -> io $ putStrLn "Not stopped at a breakpoint"
- (r:rs) -> do
- let hist = GHC.resumeHistory r
- spans <- mapM (io . GHC.getHistorySpan s) hist
- printForUser (vcat (map ppr spans))
+historyCmd arg
+ | null arg = history 20
+ | all isDigit arg = history (read arg)
+ | otherwise = io $ putStrLn "Syntax: :history [num]"
+ where
+ history num = do
+ s <- getSession
+ resumes <- io $ GHC.getResumeContext s
+ case resumes of
+ [] -> io $ putStrLn "Not stopped at a breakpoint"
+ (r:rs) -> do
+ let hist = GHC.resumeHistory r
+ (took,rest) = splitAt num hist
+ spans <- mapM (io . GHC.getHistorySpan s) took
+ let nums = map (printf "-%-3d:") [(1::Int)..]
+ printForUser (vcat (zipWith (<+>) (map text nums) (map ppr spans)))
+ io $ putStrLn $ if null rest then "<end of history>" else "..."
backCmd :: String -> GHCi ()
backCmd = noArgs $ do
io $ putStrLn "Perhaps no modules are loaded for debugging?"
| otherwise = do -- try parsing it as an identifier
wantNameFromInterpretedModule noCanDo arg1 $ \name -> do
- let loc = GHC.nameSrcLoc name
+ let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)
if GHC.isGoodSrcLoc loc
then findBreakAndSet (GHC.nameModule name) $
findBreakByCoord (Just (GHC.srcLocFile loc))
listModuleLine mod (read arg2)
list2 [arg] = do
wantNameFromInterpretedModule noCanDo arg $ \name -> do
- let loc = GHC.nameSrcLoc name
+ let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)
if GHC.isGoodSrcLoc loc
then do
tickArray <- getTickArray (GHC.nameModule name)
[ (line, (nm,span)) | (nm,span) <- ticks,
line <- srcSpanLines span ]
where
- max_line = maximum (map GHC.srcSpanEndLine (map snd ticks))
+ max_line = foldr max 0 (map GHC.srcSpanEndLine (map snd ticks))
srcSpanLines span = [ GHC.srcSpanStartLine span ..
GHC.srcSpanEndLine span ]
projects / ghc-hetmet.git / blobdiff