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'
browseModule m exports_only = do
s <- getSession
- modl <- if exports_only then lookupModule s m
- else wantInterpretedModule s m
+ modl <- if exports_only then lookupModule m
+ else wantInterpretedModule m
-- Temporarily set the context to the module we're interested in,
-- just so we can get an appropriate PrintUnqualified
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
other ->
return other
+wantInterpretedModule :: String -> GHCi Module
+wantInterpretedModule str = do
+ session <- getSession
+ modl <- lookupModule str
+ is_interpreted <- io (GHC.moduleIsInterpreted session modl)
+ when (not is_interpreted) $
+ throwDyn (CmdLineError ("module '" ++ str ++ "' is not interpreted"))
+ return modl
+
+wantNameFromInterpretedModule noCanDo str and_then = do
+ session <- getSession
+ names <- io $ GHC.parseName session str
+ case names of
+ [] -> return ()
+ (n:_) -> do
+ let modl = GHC.nameModule n
+ is_interpreted <- io (GHC.moduleIsInterpreted session modl)
+ if not is_interpreted
+ then noCanDo n $ text "module " <> ppr modl <>
+ text " is not interpreted"
+ else and_then n
+
-- ----------------------------------------------------------------------------
-- Windows console setup
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 "The break command requires at least one argument."
breakSwitch session args@(arg1:rest)
| looksLikeModuleName arg1 = do
- mod <- wantInterpretedModule session arg1
+ mod <- wantInterpretedModule arg1
breakByModule session mod rest
| all isDigit arg1 = do
(toplevel, _) <- io $ GHC.getContext session
[] -> do
io $ putStrLn "Cannot find default module for breakpoint."
io $ putStrLn "Perhaps no modules are loaded for debugging?"
- | otherwise = do -- assume it's a name
- names <- io $ GHC.parseName session arg1
- case names of
- [] -> return ()
- (n:_) -> do
- let loc = GHC.nameSrcLoc n
- modl = GHC.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 GHC.isGoodSrcLoc loc
- then findBreakAndSet (GHC.nameModule n) $
+ | otherwise = do -- try parsing it as an identifier
+ wantNameFromInterpretedModule noCanDo arg1 $ \name -> do
+ let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)
+ if GHC.isGoodSrcLoc loc
+ then findBreakAndSet (GHC.nameModule name) $
findBreakByCoord (Just (GHC.srcLocFile loc))
(GHC.srcLocLine loc,
GHC.srcLocCol loc)
- else noCanDo $ text "can't find its location: " <>
- ppr loc
- where
- noCanDo why = printForUser $
+ else noCanDo name $ text "can't find its location: " <> ppr loc
+ where
+ noCanDo n why = printForUser $
text "cannot set breakpoint on " <> ppr n <> text ": " <> why
-
-wantInterpretedModule :: Session -> String -> GHCi Module
-wantInterpretedModule session str = do
- modl <- io $ GHC.findModule session (GHC.mkModuleName str) Nothing
- is_interpreted <- io (GHC.moduleIsInterpreted session modl)
- when (not is_interpreted) $
- throwDyn (CmdLineError ("module '" ++ str ++ "' is not interpreted"))
- return modl
-
breakByModule :: Session -> Module -> [String] -> GHCi ()
breakByModule session mod args@(arg1:rest)
| all isDigit arg1 = do -- looks like a line number
end_bold = BS.pack "\ESC[0m"
listCmd :: String -> GHCi ()
-listCmd str = do
+listCmd "" = do
mb_span <- getCurrentBreakSpan
case mb_span of
Nothing -> printForUser $ text "not stopped at a breakpoint; nothing to list"
Just span -> io $ listAround span True
+listCmd str = list2 (words str)
+
+list2 [arg] | all isDigit arg = do
+ session <- getSession
+ (toplevel, _) <- io $ GHC.getContext session
+ case toplevel of
+ [] -> io $ putStrLn "No module to list"
+ (mod : _) -> listModuleLine mod (read arg)
+list2 [arg1,arg2] | looksLikeModuleName arg1, all isDigit arg2 = do
+ mod <- wantInterpretedModule arg1
+ listModuleLine mod (read arg2)
+list2 [arg] = do
+ wantNameFromInterpretedModule noCanDo arg $ \name -> do
+ let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)
+ if GHC.isGoodSrcLoc loc
+ then do
+ tickArray <- getTickArray (GHC.nameModule name)
+ let mb_span = findBreakByCoord (Just (GHC.srcLocFile loc))
+ (GHC.srcLocLine loc, GHC.srcLocCol loc)
+ tickArray
+ case mb_span of
+ Nothing -> io $ listAround (GHC.srcLocSpan loc) False
+ Just (_,span) -> io $ listAround span False
+ else
+ noCanDo name $ text "can't find its location: " <>
+ ppr loc
+ where
+ noCanDo n why = printForUser $
+ text "cannot list source code for " <> ppr n <> text ": " <> why
+list2 _other =
+ io $ putStrLn "syntax: :list [<line> | <module> <line> | <identifier>]"
+
+listModuleLine :: Module -> Int -> GHCi ()
+listModuleLine modl line = do
+ session <- getSession
+ graph <- io (GHC.getModuleGraph session)
+ let this = filter ((== modl) . GHC.ms_mod) graph
+ case this of
+ [] -> panic "listModuleLine"
+ summ:_ -> do
+ let filename = fromJust (ml_hs_file (GHC.ms_location summ))
+ loc = GHC.mkSrcLoc (mkFastString (filename)) line 0
+ io $ listAround (GHC.srcLocSpan loc) False
-- | list a section of a source file around a particular SrcSpan.
-- If the highlight flag is True, also highlight the span using
[ (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 ]
-lookupModule :: Session -> String -> GHCi Module
-lookupModule session modName
- = io (GHC.findModule session (GHC.mkModuleName modName) Nothing)
+lookupModule :: String -> GHCi Module
+lookupModule modName
+ = do session <- getSession
+ io (GHC.findModule session (GHC.mkModuleName modName) Nothing)
-- don't reset the counter back to zero?
discardActiveBreakPoints :: GHCi ()
projects / ghc-hetmet.git / blobdiff