X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fghci%2FInteractiveUI.hs;h=b794436b952d1a96464d6cb1424e4c1e419218da;hp=d92cc53ad9eec9be4efcf4f346fe97ebb93f52e2;hb=cdce647711c0f46f5799b24de087622cb77e647f;hpb=03803f88cccbee0d2a4180015fffa02a803c20d6 diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs index d92cc53..b794436 100644 --- a/compiler/ghci/InteractiveUI.hs +++ b/compiler/ghci/InteractiveUI.hs @@ -3,7 +3,7 @@ -- -- GHC Interactive User Interface -- --- (c) The GHC Team 2005 +-- (c) The GHC Team 2005-2006 -- ----------------------------------------------------------------------------- module InteractiveUI ( @@ -13,52 +13,44 @@ module InteractiveUI ( #include "HsVersions.h" -#if defined(GHCI) && defined(BREAKPOINT) -import GHC.Exts ( Int(..), Ptr(..), int2Addr# ) -import Foreign.StablePtr ( deRefStablePtr, castPtrToStablePtr ) -import System.IO.Unsafe ( unsafePerformIO ) -import Var ( Id, globaliseId, idName, idType ) -import HscTypes ( Session(..), InteractiveContext(..), HscEnv(..) - , extendTypeEnvWithIds ) -import RdrName ( extendLocalRdrEnv, mkRdrUnqual, lookupLocalRdrEnv ) -import NameEnv ( delListFromNameEnv ) -import TcType ( tidyTopType ) -import qualified Id ( setIdType ) -import IdInfo ( GlobalIdDetails(..) ) -import Linker ( HValue, extendLinkEnv, withExtendedLinkEnv,initDynLinker ) -import PrelNames ( breakpointJumpName, breakpointCondJumpName ) -#endif +import GhciMonad -- The GHC interface import qualified GHC -import GHC ( Session, verbosity, dopt, DynFlag(..), Target(..), - TargetId(..), DynFlags(..), - pprModule, Type, Module, SuccessFlag(..), - TyThing(..), Name, LoadHowMuch(..), Phase, - GhcException(..), showGhcException, - CheckedModule(..), SrcLoc ) -import DynFlags ( allFlags ) -import Packages ( PackageState(..) ) -import PackageConfig ( InstalledPackageInfo(..) ) -import UniqFM ( eltsUFM ) +import GHC ( Session, LoadHowMuch(..), Target(..), TargetId(..), + Type, Module, ModuleName, TyThing(..), Phase ) +import DynFlags +import Packages +import PackageConfig +import UniqFM import PprTyThing import Outputable --- for createtags (should these come via GHC?) -import Module ( moduleString ) -import Name ( nameSrcLoc, nameModule, nameOccName ) -import OccName ( pprOccName ) -import SrcLoc ( isGoodSrcLoc, srcLocFile, srcLocLine, srcLocCol ) +-- for createtags +import Name +import OccName +import SrcLoc -- Other random utilities -import Digraph ( flattenSCCs ) -import BasicTypes ( failed, successIf ) -import Panic ( panic, installSignalHandlers ) +import Digraph +import BasicTypes hiding (isTopLevel) +import Panic hiding (showException) import Config -import StaticFlags ( opt_IgnoreDotGhci ) -import Linker ( showLinkerState ) -import Util ( removeSpaces, handle, global, toArgs, - looksLikeModuleName, prefixMatch, sortLe ) +import StaticFlags +import Linker +import Util + +-- The debugger +import Debugger +import HscTypes +import Id +import Var ( globaliseId ) +import IdInfo +import NameEnv +import RdrName +import Module +import Type +import TcType #ifndef mingw32_HOST_OS import System.Posix @@ -67,6 +59,8 @@ import System.Posix #endif #else import GHC.ConsoleHandler ( flushConsole ) +import System.Win32 ( setConsoleCP, setConsoleOutputCP ) +import qualified System.Win32 #endif #ifdef USE_READLINE @@ -77,32 +71,35 @@ import System.Console.Readline as Readline --import SystemExts import Control.Exception as Exception -import Data.Dynamic -- import Control.Concurrent -import Numeric import Data.List -import Data.Int ( Int64 ) -import Data.Maybe ( isJust, fromMaybe, catMaybes ) +import Data.Maybe ( isJust, isNothing, fromMaybe, catMaybes ) import System.Cmd -import System.CPUTime import System.Environment import System.Exit ( exitWith, ExitCode(..) ) import System.Directory import System.IO import System.IO.Error as IO import Data.Char +import Data.Dynamic +import Data.Array import Control.Monad as Monad -import Foreign.StablePtr ( newStablePtr ) -import Text.Printf +import Foreign.StablePtr ( StablePtr, newStablePtr, deRefStablePtr, freeStablePtr ) import GHC.Exts ( unsafeCoerce# ) -import GHC.IOBase ( IOErrorType(InvalidArgument) ) +import GHC.IOBase ( IOErrorType(InvalidArgument), IO(IO) ) -import Data.IORef ( IORef, newIORef, readIORef, writeIORef ) +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 +import TickTree + ----------------------------------------------------------------------------- ghciWelcomeMsg = @@ -119,32 +116,50 @@ GLOBAL_VAR(commands, builtin_commands, [Command]) builtin_commands :: [Command] builtin_commands = [ - ("add", keepGoingPaths addModule, False, completeFilename), + -- Hugs users are accustomed to :e, so make sure it doesn't overlap + ("?", keepGoing help, False, completeNone), + ("add", tlC$ keepGoingPaths addModule, False, completeFilename), + ("break", breakCmd, False, completeNone), ("browse", keepGoing browseCmd, False, completeModule), - ("cd", keepGoing changeDirectory, False, completeFilename), + ("cd", tlC$ keepGoing changeDirectory, False, completeFilename), + ("check", keepGoing checkModule, False, completeHomeModule), + ("continue", continueCmd, False, completeNone), + ("ctags", keepGoing createCTagsFileCmd, False, completeFilename), ("def", keepGoing defineMacro, False, completeIdentifier), + ("delete", deleteCmd, False, completeNone), + ("e", keepGoing editFile, False, completeFilename), + ("edit", keepGoing editFile, False, completeFilename), + ("etags", keepGoing createETagsFileCmd, False, completeFilename), + ("force", keepGoing (pprintClosureCommand False True), False, completeIdentifier), ("help", keepGoing help, False, completeNone), - ("?", keepGoing help, False, completeNone), ("info", keepGoing info, False, completeIdentifier), - ("load", keepGoingPaths loadModule_, False, completeHomeModuleOrFile), + ("kind", keepGoing kindOfType, False, completeIdentifier), + ("load", tlC$ keepGoingPaths loadModule_,False, completeHomeModuleOrFile), ("module", keepGoing setContext, False, completeModule), - ("main", keepGoing runMain, False, completeIdentifier), - ("reload", keepGoing reloadModule, False, completeNone), - ("check", keepGoing checkModule, False, completeHomeModule), + ("main", tlC$ keepGoing runMain, False, completeIdentifier), + ("print", keepGoing (pprintClosureCommand True False), False, completeIdentifier), + ("quit", quit, False, completeNone), + ("reload", tlC$ keepGoing reloadModule, False, completeNone), ("set", keepGoing setCmd, True, completeSetOptions), ("show", keepGoing showCmd, False, completeNone), - ("etags", keepGoing createETagsFileCmd, False, completeFilename), - ("ctags", keepGoing createCTagsFileCmd, False, completeFilename), + ("sprint", keepGoing (pprintClosureCommand False False),False, completeIdentifier), + ("step", stepCmd, False, completeNone), ("type", keepGoing typeOfExpr, False, completeIdentifier), - ("kind", keepGoing kindOfType, False, completeIdentifier), - ("unset", keepGoing unsetOptions, True, completeSetOptions), ("undef", keepGoing undefineMacro, False, completeMacro), - ("quit", quit, False, completeNone) + ("unset", keepGoing unsetOptions, True, completeSetOptions) ] keepGoing :: (String -> GHCi ()) -> (String -> GHCi Bool) keepGoing a str = a str >> return False +-- tlC: Top Level Command, not allowed in inferior sessions +tlC :: (String -> GHCi Bool) -> (String -> GHCi Bool) +tlC a str = do + top_level <- isTopLevel + if not top_level + then throwDyn (CmdLineError "Command only allowed at Top Level") + else a str + keepGoingPaths :: ([FilePath] -> GHCi ()) -> (String -> GHCi Bool) keepGoingPaths a str = a (toArgs str) >> return False @@ -159,8 +174,12 @@ helpText = " :browse [*] display the names defined by \n" ++ " :cd change directory to \n" ++ " :def define a command :\n" ++ + " :edit edit file\n" ++ + " :edit edit last module\n" ++ " :help, :? display this list of commands\n" ++ " :info [ ...] display information about the given names\n" ++ + " :print [ ...] prints a value without forcing its computation\n" ++ + " :sprint [ ...] simplified version of :print\n" ++ " :load ... load module(s) and their dependents\n" ++ " :module [+/-] [*] ... set the context for expression evaluation\n" ++ " :main [ ...] run the main function with the given arguments\n" ++ @@ -170,12 +189,13 @@ helpText = " :set args ... set the arguments returned by System.getArgs\n" ++ " :set prog set the value returned by System.getProgName\n" ++ " :set prompt set the prompt used in GHCi\n" ++ + " :set editor set the command used for :edit\n" ++ "\n" ++ " :show modules show the currently loaded modules\n" ++ " :show bindings show the current bindings made at the prompt\n" ++ "\n" ++ " :ctags [] create tags file for Vi (default: \"tags\")\n" ++ - " :etags [] create tags file for Emacs (defauilt: \"TAGS\")\n" ++ + " :etags [] create tags file for Emacs (default: \"TAGS\")\n" ++ " :type show the type of \n" ++ " :kind show the kind of \n" ++ " :undef undefine user-defined command :\n" ++ @@ -189,76 +209,22 @@ helpText = " +s print timing/memory stats after each evaluation\n" ++ " +t print type after evaluation\n" ++ " - most GHC command line flags can also be set here\n" ++ - " (eg. -v2, -fglasgow-exts, etc.)\n" - - -#if defined(GHCI) && defined(BREAKPOINT) -globaliseAndTidy :: Id -> Id -globaliseAndTidy id --- Give the Id a Global Name, and tidy its type - = Id.setIdType (globaliseId VanillaGlobal id) tidy_type - where - tidy_type = tidyTopType (idType id) - - -printScopeMsg :: Session -> String -> [Id] -> IO () -printScopeMsg session location ids - = GHC.getPrintUnqual session >>= \unqual -> - printForUser stdout unqual $ - text "Local bindings in scope:" $$ - nest 2 (pprWithCommas showId ids) - where showId id = ppr (idName id) <+> dcolon <+> ppr (idType id) - -jumpCondFunction :: Session -> Int -> [HValue] -> String -> Bool -> b -> b -jumpCondFunction session ptr hValues location True b = b -jumpCondFunction session ptr hValues location False b - = jumpFunction session ptr hValues location b - -jumpFunction :: Session -> Int -> [HValue] -> String -> b -> b -jumpFunction session@(Session ref) (I# idsPtr) hValues location b - = unsafePerformIO $ - do ids <- deRefStablePtr (castPtrToStablePtr (Ptr (int2Addr# idsPtr))) - let names = map idName ids - ASSERT (length names == length hValues) return () - printScopeMsg session location ids - hsc_env <- readIORef ref - - let ictxt = hsc_IC hsc_env - global_ids = map globaliseAndTidy ids - rn_env = ic_rn_local_env ictxt - type_env = ic_type_env ictxt - bound_names = map idName global_ids - new_rn_env = extendLocalRdrEnv rn_env bound_names - -- Remove any shadowed bindings from the type_env; - -- they are inaccessible but might, I suppose, cause - -- a space leak if we leave them there - shadowed = [ n | name <- bound_names, - let rdr_name = mkRdrUnqual (nameOccName name), - Just n <- [lookupLocalRdrEnv rn_env rdr_name] ] - filtered_type_env = delListFromNameEnv type_env shadowed - new_type_env = extendTypeEnvWithIds filtered_type_env global_ids - new_ic = ictxt { ic_rn_local_env = new_rn_env, - ic_type_env = new_type_env } - writeIORef ref (hsc_env { hsc_IC = new_ic }) - withExtendedLinkEnv (zip names hValues) $ - startGHCi (runGHCi [] Nothing) - GHCiState{ progname = "", - args = [], - prompt = location++"> ", - session = session, - options = [] } - writeIORef ref hsc_env - putStrLn $ "Returning to normal execution..." - return b + " (eg. -v2, -fglasgow-exts, etc.)\n" ++ + "\n" +-- Todo: add help for breakpoint commands here + +findEditor = do + getEnv "EDITOR" + `IO.catch` \_ -> do +#if mingw32_HOST_OS + win <- System.Win32.getWindowsDirectory + return (win `joinFileName` "notepad.exe") +#else + return "" #endif interactiveUI :: Session -> [(FilePath, Maybe Phase)] -> Maybe String -> IO () interactiveUI session srcs maybe_expr = do -#if defined(GHCI) && defined(BREAKPOINT) - initDynLinker =<< GHC.getSessionDynFlags session - extendLinkEnv [(breakpointJumpName,unsafeCoerce# (jumpFunction session)) - ,(breakpointCondJumpName,unsafeCoerce# (jumpCondFunction session))] -#endif -- HACK! If we happen to get into an infinite loop (eg the user -- types 'let x=x in x' at the prompt), then the thread will block -- on a blackhole, and become unreachable during GC. The GC will @@ -271,18 +237,23 @@ interactiveUI session srcs maybe_expr = do newStablePtr stdout newStablePtr stderr - hFlush stdout - hSetBuffering stdout NoBuffering - -- Initialise buffering for the *interpreted* I/O system initInterpBuffering session + when (isNothing maybe_expr) $ do + -- Only for GHCi (not runghc and ghc -e): + -- Turn buffering off for the compiled program's stdout/stderr + turnOffBuffering + -- Turn buffering off for GHCi's stdout + hFlush stdout + hSetBuffering stdout NoBuffering -- We don't want the cmd line to buffer any input that might be -- intended for the program, so unbuffer stdin. - hSetBuffering stdin NoBuffering + hSetBuffering stdin NoBuffering -- initial context is just the Prelude - GHC.setContext session [] [prelude_mod] + prel_mod <- GHC.findModule session prel_name (Just basePackageId) + GHC.setContext session [] [prel_mod] #ifdef USE_READLINE Readline.initialize @@ -298,12 +269,20 @@ interactiveUI session srcs maybe_expr = do Readline.setCompleterWordBreakCharacters word_break_chars #endif + default_editor <- findEditor + startGHCi (runGHCi srcs maybe_expr) GHCiState{ progname = "", args = [], prompt = "%s> ", + editor = default_editor, session = session, - options = [] } + options = [], + prelude = prel_mod, + topLevel = True, + resume = [], + breaks = emptyActiveBreakPoints + } #ifdef USE_READLINE Readline.resetTerminal Nothing @@ -311,6 +290,8 @@ interactiveUI session srcs maybe_expr = do return () +prel_name = GHC.mkModuleName "Prelude" + runGHCi :: [(FilePath, Maybe Phase)] -> Maybe String -> GHCi () runGHCi paths maybe_expr = do let read_dot_files = not opt_IgnoreDotGhci @@ -361,8 +342,8 @@ runGHCi paths maybe_expr = do case maybe_expr of Nothing -> -#if defined(mingw32_HOST_OS) do +#if defined(mingw32_HOST_OS) -- The win32 Console API mutates the first character of -- type-ahead when reading from it in a non-buffered manner. Work -- around this by flushing the input buffer of type-ahead characters, @@ -373,6 +354,9 @@ runGHCi paths maybe_expr = do | otherwise -> io (ioError err) Right () -> return () #endif + -- initialise the console if necessary + io setUpConsole + -- enter the interactive loop interactiveLoop is_tty show_prompt Just expr -> do @@ -476,8 +460,8 @@ mkPrompt toplevs exports prompt f (x:xs) = char x <> f xs f [] = empty - perc_s = hsep (map (\m -> char '*' <> pprModule m) toplevs) <+> - hsep (map pprModule exports) + perc_s = hsep (map (\m -> char '*' <> ppr (GHC.moduleName m)) toplevs) <+> + hsep (map (ppr . GHC.moduleName) exports) #ifdef USE_READLINE @@ -518,7 +502,7 @@ runCommand c = ghciHandle handler (doCommand c) runCommandEval c = ghciHandle handleEval (doCommand c) where handleEval (ExitException code) = io (exitWith code) - handleEval e = do showException e + handleEval e = do handler e io (exitWith (ExitFailure 1)) doCommand (':' : command) = specialCommand command @@ -529,32 +513,6 @@ runCommandEval c = ghciHandle handleEval (doCommand c) -- failure to run the command causes exit(1) for ghc -e. _ -> finishEvalExpr nms --- This is the exception handler for exceptions generated by the --- user's code; it normally just prints out the exception. The --- handler must be recursive, in case showing the exception causes --- more exceptions to be raised. --- --- Bugfix: if the user closed stdout or stderr, the flushing will fail, --- raising another exception. We therefore don't put the recursive --- handler arond the flushing operation, so if stderr is closed --- GHCi will just die gracefully rather than going into an infinite loop. -handler :: Exception -> GHCi Bool -handler exception = do - flushInterpBuffers - io installSignalHandlers - ghciHandle handler (showException exception >> return False) - -showException (DynException dyn) = - case fromDynamic dyn of - Nothing -> io (putStrLn ("*** Exception: (unknown)")) - Just Interrupted -> io (putStrLn "Interrupted.") - Just (CmdLineError s) -> io (putStrLn s) -- omit the location for CmdLineError - Just ph@PhaseFailed{} -> io (putStrLn (showGhcException ph "")) -- ditto - Just other_ghc_ex -> io (print other_ghc_ex) - -showException other_exception - = io (putStrLn ("*** Exception: " ++ show other_exception)) - runStmt :: String -> GHCi (Maybe [Name]) runStmt stmt | null (filter (not.isSpace) stmt) = return (Just []) @@ -563,10 +521,84 @@ runStmt stmt session <- getSession result <- io $ withProgName (progname st) $ withArgs (args st) $ GHC.runStmt session stmt - case result of - GHC.RunFailed -> return Nothing - GHC.RunException e -> throw e -- this is caught by runCommand(Eval) - GHC.RunOk names -> return (Just names) + switchOnRunResult result + +switchOnRunResult :: GHC.RunResult -> GHCi (Maybe [Name]) +switchOnRunResult GHC.RunFailed = return Nothing +switchOnRunResult (GHC.RunException e) = throw e +switchOnRunResult (GHC.RunOk names) = return $ Just names +switchOnRunResult (GHC.RunBreak apStack _threadId info resume) = do -- Todo: we don't use threadID, perhaps delete? + session <- getSession + Just mod_info <- io $ GHC.getModuleInfo session (breakInfo_module info) + let modBreaks = GHC.modInfoModBreaks mod_info + let ticks = modBreaks_ticks modBreaks + io $ displayBreakInfo session ticks info + io $ extendEnvironment session apStack (breakInfo_vars info) + pushResume resume + return Nothing + +displayBreakInfo :: Session -> Array Int SrcSpan -> BreakInfo -> IO () +displayBreakInfo session ticks info = do + unqual <- GHC.getPrintUnqual session + let location = ticks ! breakInfo_number info + printForUser stdout unqual $ + ptext SLIT("Stopped at") <+> ppr location $$ localsMsg + where + vars = map fst $ breakInfo_vars info + localsMsg = if null vars + then text "No locals in scope." + else text "Locals:" <+> (pprWithCommas showId vars) + showId id = ppr (idName id) <+> dcolon <+> ppr (idType id) + +-- Todo: turn this into a primop, and provide special version(s) for unboxed things +foreign import ccall "rts_getApStackVal" getApStackVal :: StablePtr a -> Int -> IO (StablePtr b) + +getIdValFromApStack :: a -> (Id, Int) -> IO (Id, HValue) +getIdValFromApStack apStack (identifier, stackDepth) = do + -- ToDo: check the type of the identifer and decide whether it is unboxed or not + apSptr <- newStablePtr apStack + resultSptr <- getApStackVal apSptr (stackDepth - 1) + result <- deRefStablePtr resultSptr + freeStablePtr apSptr + freeStablePtr resultSptr + return (identifier, unsafeCoerce# result) + +extendEnvironment :: Session -> a -> [(Id, Int)] -> IO () +extendEnvironment s@(Session ref) apStack idsOffsets = do + idsVals <- mapM (getIdValFromApStack apStack) idsOffsets + let (ids, hValues) = unzip idsVals + let names = map idName ids + let global_ids = map globaliseAndTidy ids + typed_ids <- mapM instantiateIdType global_ids + hsc_env <- readIORef ref + let ictxt = hsc_IC hsc_env + rn_env = ic_rn_local_env ictxt + type_env = ic_type_env ictxt + bound_names = map idName typed_ids + new_rn_env = extendLocalRdrEnv rn_env bound_names + -- Remove any shadowed bindings from the type_env; + -- they are inaccessible but might, I suppose, cause + -- a space leak if we leave them there + shadowed = [ n | name <- bound_names, + let rdr_name = mkRdrUnqual (nameOccName name), + Just n <- [lookupLocalRdrEnv rn_env rdr_name] ] + filtered_type_env = delListFromNameEnv type_env shadowed + new_type_env = extendTypeEnvWithIds filtered_type_env (typed_ids) + new_ic = ictxt { ic_rn_local_env = new_rn_env, + ic_type_env = new_type_env } + writeIORef ref (hsc_env { hsc_IC = new_ic }) + extendLinkEnv (zip names hValues) -- ToDo: we must remember to restore the old env after we finish a breakpoint + where + globaliseAndTidy :: Id -> Id + globaliseAndTidy id + = let tidied_type = tidyTopType$ idType id + in setIdType (globaliseId VanillaGlobal id) tidied_type + + -- | Instantiate the tyVars with GHC.Base.Unknown + instantiateIdType :: Id -> IO Id + instantiateIdType id = do + instantiatedType <- instantiateTyVarsToUnknown s (idType id) + return$ setIdType id instantiatedType -- possibly print the type and revert CAFs after evaluating an expression finishEvalExpr mb_names @@ -589,12 +621,6 @@ showTypeOfName session n Nothing -> return () Just thing -> showTyThing thing -showForUser :: SDoc -> GHCi String -showForUser doc = do - session <- getSession - unqual <- io (GHC.getPrintUnqual session) - return $! showSDocForUser unqual doc - specialCommand :: String -> GHCi Bool specialCommand ('!':str) = shellEscape (dropWhile isSpace str) specialCommand str = do @@ -616,45 +642,6 @@ lookupCommand str = do c:_ -> return (Just c) ----------------------------------------------------------------------------- --- To flush buffers for the *interpreted* computation we need --- to refer to *its* stdout/stderr handles - -GLOBAL_VAR(flush_interp, error "no flush_interp", IO ()) -GLOBAL_VAR(turn_off_buffering, error "no flush_stdout", IO ()) - -no_buf_cmd = "System.IO.hSetBuffering System.IO.stdout System.IO.NoBuffering" ++ - " Prelude.>> System.IO.hSetBuffering System.IO.stderr System.IO.NoBuffering" -flush_cmd = "System.IO.hFlush System.IO.stdout Prelude.>> System.IO.hFlush IO.stderr" - -initInterpBuffering :: Session -> IO () -initInterpBuffering session - = do maybe_hval <- GHC.compileExpr session no_buf_cmd - - case maybe_hval of - Just hval -> writeIORef turn_off_buffering (unsafeCoerce# hval :: IO ()) - other -> panic "interactiveUI:setBuffering" - - maybe_hval <- GHC.compileExpr session flush_cmd - case maybe_hval of - Just hval -> writeIORef flush_interp (unsafeCoerce# hval :: IO ()) - _ -> panic "interactiveUI:flush" - - turnOffBuffering -- Turn it off right now - - return () - - -flushInterpBuffers :: GHCi () -flushInterpBuffers - = io $ do Monad.join (readIORef flush_interp) - return () - -turnOffBuffering :: IO () -turnOffBuffering - = do Monad.join (readIORef turn_off_buffering) - return () - ------------------------------------------------------------------------------ -- Commands help :: String -> GHCi () @@ -683,7 +670,8 @@ info s = do { let names = words s filterOutChildren :: [Name] -> [Name] filterOutChildren names = filter (not . parent_is_there) names where parent_is_there n - | Just p <- GHC.nameParent_maybe n = p `elem` names +-- | Just p <- GHC.nameParent_maybe n = p `elem` names +-- ToDo!! | otherwise = False pprInfo exts (thing, fixity, insts) @@ -727,6 +715,27 @@ changeDirectory dir = do dir <- expandPath dir io (setCurrentDirectory dir) +editFile :: String -> GHCi () +editFile str + | null str = do + -- find the name of the "topmost" file loaded + session <- getSession + graph0 <- io (GHC.getModuleGraph session) + graph1 <- filterM (io . GHC.isLoaded session . GHC.ms_mod_name) graph0 + let graph2 = flattenSCCs (GHC.topSortModuleGraph True graph1 Nothing) + case GHC.ml_hs_file (GHC.ms_location (last graph2)) of + Just file -> do_edit file + Nothing -> throwDyn (CmdLineError "unknown file name") + | otherwise = do_edit str + where + do_edit file = do + st <- getGHCiState + let cmd = editor st + when (null cmd) $ + throwDyn (CmdLineError "editor not set, use :set editor") + io $ system (cmd ++ ' ':file) + return () + defineMacro :: String -> GHCi () defineMacro s = do let (macro_name, definition) = break isSpace s @@ -802,16 +811,16 @@ loadModule' files = do checkModule :: String -> GHCi () checkModule m = do - let modl = GHC.mkModule m + let modl = GHC.mkModuleName m session <- getSession result <- io (GHC.checkModule session modl) case result of Nothing -> io $ putStrLn "Nothing" Just r -> io $ putStrLn (showSDoc ( - case checkedModuleInfo r of + case GHC.checkedModuleInfo r of Just cm | Just scope <- GHC.modInfoTopLevelScope cm -> let - (local,global) = partition ((== modl) . GHC.nameModule) scope + (local,global) = partition ((== modl) . GHC.moduleName . GHC.nameModule) scope in (text "global names: " <+> ppr global) $$ (text "local names: " <+> ppr local) @@ -827,22 +836,19 @@ reloadModule "" = do reloadModule m = do io (revertCAFs) -- always revert CAFs on reload. session <- getSession - ok <- io (GHC.load session (LoadUpTo (GHC.mkModule m))) + ok <- io (GHC.load session (LoadUpTo (GHC.mkModuleName m))) afterLoad ok session afterLoad ok session = do io (revertCAFs) -- always revert CAFs on load. graph <- io (GHC.getModuleGraph session) - graph' <- filterM (io . GHC.isLoaded session . GHC.ms_mod) graph + graph' <- filterM (io . GHC.isLoaded session . GHC.ms_mod_name) graph setContextAfterLoad session graph' - modulesLoadedMsg ok (map GHC.ms_mod graph') -#if defined(GHCI) && defined(BREAKPOINT) - io (extendLinkEnv [(breakpointJumpName,unsafeCoerce# (jumpFunction session)) - ,(breakpointCondJumpName,unsafeCoerce# (jumpCondFunction session))]) -#endif + modulesLoadedMsg ok (map GHC.ms_mod_name graph') setContextAfterLoad session [] = do - io (GHC.setContext session [] [prelude_mod]) + prel_mod <- getPrelude + io (GHC.setContext session [] [prel_mod]) setContextAfterLoad session ms = do -- load a target if one is available, otherwise load the topmost module. targets <- io (GHC.getTargets session) @@ -859,7 +865,7 @@ setContextAfterLoad session ms = do (m:_) -> Just m summary `matches` Target (TargetModule m) _ - = GHC.ms_mod summary == m + = GHC.ms_mod_name summary == m summary `matches` Target (TargetFile f _) _ | Just f' <- GHC.ml_hs_file (GHC.ms_location summary) = f == f' summary `matches` target @@ -868,17 +874,19 @@ setContextAfterLoad session ms = do load_this summary | m <- GHC.ms_mod summary = do b <- io (GHC.moduleIsInterpreted session m) if b then io (GHC.setContext session [m] []) - else io (GHC.setContext session [] [prelude_mod,m]) + else do + prel_mod <- getPrelude + io (GHC.setContext session [] [prel_mod,m]) -modulesLoadedMsg :: SuccessFlag -> [Module] -> GHCi () +modulesLoadedMsg :: SuccessFlag -> [ModuleName] -> GHCi () modulesLoadedMsg ok mods = do dflags <- getDynFlags when (verbosity dflags > 0) $ do let mod_commas | null mods = text "none." | otherwise = hsep ( - punctuate comma (map pprModule mods)) <> text "." + punctuate comma (map ppr mods)) <> text "." case ok of Failed -> io (putStrLn (showSDoc (text "Failed, modules loaded: " <> mod_commas))) @@ -904,7 +912,7 @@ kindOfType str Nothing -> return () Just ty -> do tystr <- showForUser (ppr ty) io (putStrLn (str ++ " :: " ++ tystr)) - + quit :: String -> GHCi Bool quit _ = return True @@ -945,8 +953,9 @@ createTagsFile session tagskind tagFile = do is_interpreted <- GHC.moduleIsInterpreted session m -- should we just skip these? when (not is_interpreted) $ - throwDyn (CmdLineError ("module '" ++ moduleString m ++ "' is not interpreted")) - + throwDyn (CmdLineError ("module '" + ++ GHC.moduleNameString (GHC.moduleName m) + ++ "' is not interpreted")) mbModInfo <- GHC.getModuleInfo session m let unqual | Just modinfo <- mbModInfo, @@ -1034,8 +1043,7 @@ browseCmd m = browseModule m exports_only = do s <- getSession - - let modl = GHC.mkModule m + modl <- io $ GHC.findModule s (GHC.mkModuleName m) Nothing is_interpreted <- io (GHC.moduleIsInterpreted s modl) when (not is_interpreted && not exports_only) $ throwDyn (CmdLineError ("module '" ++ m ++ "' is not interpreted")) @@ -1043,7 +1051,8 @@ browseModule m exports_only = do -- Temporarily set the context to the module we're interested in, -- just so we can get an appropriate PrintUnqualified (as,bs) <- io (GHC.getContext s) - io (if exports_only then GHC.setContext s [] [prelude_mod,modl] + prel_mod <- getPrelude + io (if exports_only then GHC.setContext s [] [prel_mod,modl] else GHC.setContext s [modl] []) unqual <- io (GHC.getPrintUnqual s) io (GHC.setContext s as bs) @@ -1084,47 +1093,53 @@ setContext str sensible ('*':m) = looksLikeModuleName m sensible m = looksLikeModuleName m -newContext mods = do - session <- getSession - (as,bs) <- separate session mods [] [] - let bs' = if null as && prelude_mod `notElem` bs then prelude_mod:bs else bs - io (GHC.setContext session as bs') - -separate :: Session -> [String] -> [Module] -> [Module] - -> GHCi ([Module],[Module]) +separate :: Session -> [String] -> [Module] -> [Module] + -> GHCi ([Module],[Module]) separate session [] as bs = return (as,bs) -separate session (('*':m):ms) as bs = do - let modl = GHC.mkModule m - b <- io (GHC.moduleIsInterpreted session modl) - if b then separate session ms (modl:as) bs - else throwDyn (CmdLineError ("module '" ++ m ++ "' is not interpreted")) -separate session (m:ms) as bs = separate session ms as (GHC.mkModule m:bs) - -prelude_mod = GHC.mkModule "Prelude" +separate session (('*':str):ms) as bs = do + m <- io $ GHC.findModule session (GHC.mkModuleName str) Nothing + b <- io $ GHC.moduleIsInterpreted session m + if b then separate session ms (m:as) bs + else throwDyn (CmdLineError ("module '" + ++ GHC.moduleNameString (GHC.moduleName m) + ++ "' is not interpreted")) +separate session (str:ms) as bs = do + m <- io $ GHC.findModule session (GHC.mkModuleName str) Nothing + separate session ms as (m:bs) + +newContext :: [String] -> GHCi () +newContext strs = do + s <- getSession + (as,bs) <- separate s strs [] [] + prel_mod <- getPrelude + let bs' = if null as && prel_mod `notElem` bs then prel_mod:bs else bs + io $ GHC.setContext s as bs' -addToContext mods = do - cms <- getSession - (as,bs) <- io (GHC.getContext cms) +addToContext :: [String] -> GHCi () +addToContext strs = do + s <- getSession + (as,bs) <- io $ GHC.getContext s - (as',bs') <- separate cms mods [] [] + (new_as,new_bs) <- separate s strs [] [] - let as_to_add = as' \\ (as ++ bs) - bs_to_add = bs' \\ (as ++ bs) + let as_to_add = new_as \\ (as ++ bs) + bs_to_add = new_bs \\ (as ++ bs) - io (GHC.setContext cms (as ++ as_to_add) (bs ++ bs_to_add)) + io $ GHC.setContext s (as ++ as_to_add) (bs ++ bs_to_add) -removeFromContext mods = do - cms <- getSession - (as,bs) <- io (GHC.getContext cms) +removeFromContext :: [String] -> GHCi () +removeFromContext strs = do + s <- getSession + (as,bs) <- io $ GHC.getContext s - (as_to_remove,bs_to_remove) <- separate cms mods [] [] + (as_to_remove,bs_to_remove) <- separate s strs [] [] let as' = as \\ (as_to_remove ++ bs_to_remove) bs' = bs \\ (as_to_remove ++ bs_to_remove) - io (GHC.setContext cms as' bs') + io $ GHC.setContext s as' bs' ---------------------------------------------------------------------------- -- Code for `:set' @@ -1147,11 +1162,13 @@ setCmd "" else hsep (map (\o -> char '+' <> text (optToStr o)) opts) )) setCmd str - = case words str of + = case toArgs str of ("args":args) -> setArgs args ("prog":prog) -> setProg prog - ("prompt":prompt) -> setPrompt (dropWhile isSpace $ drop 6 $ dropWhile isSpace str) + ("prompt":prompt) -> setPrompt (after 6) + ("editor":cmd) -> setEditor (after 6) wds -> setOptions wds + where after n = dropWhile isSpace $ drop n $ dropWhile isSpace str setArgs args = do st <- getGHCiState @@ -1163,6 +1180,10 @@ setProg [prog] = do setProg _ = do io (hPutStrLn stderr "syntax: :set prog ") +setEditor cmd = do + st <- getGHCiState + setGHCiState st{ editor = cmd } + setPrompt value = do st <- getGHCiState if null value @@ -1179,21 +1200,28 @@ setOptions wds = -- then, dynamic flags dflags <- getDynFlags + let pkg_flags = packageFlags dflags (dflags',leftovers) <- io $ GHC.parseDynamicFlags dflags minus_opts - setDynFlags dflags' - - -- update things if the users wants more packages -{- TODO: - let new_packages = pkgs_after \\ pkgs_before - when (not (null new_packages)) $ - newPackages new_packages --} if (not (null leftovers)) then throwDyn (CmdLineError ("unrecognised flags: " ++ unwords leftovers)) else return () + new_pkgs <- setDynFlags dflags' + + -- if the package flags changed, we should reset the context + -- and link the new packages. + dflags <- getDynFlags + when (packageFlags dflags /= pkg_flags) $ do + io $ hPutStrLn stderr "package flags have changed, ressetting and loading new packages..." + session <- getSession + io (GHC.setTargets session []) + io (GHC.load session LoadAllTargets) + io (linkPackages dflags new_pkgs) + setContextAfterLoad session [] + return () + unsetOptions :: String -> GHCi () unsetOptions str @@ -1240,16 +1268,6 @@ optToStr ShowTiming = "s" optToStr ShowType = "t" optToStr RevertCAFs = "r" -{- ToDo -newPackages new_pkgs = do -- The new packages are already in v_Packages - session <- getSession - io (GHC.setTargets session []) - io (GHC.load session Nothing) - dflags <- getDynFlags - io (linkPackages dflags new_pkgs) - setContextAfterLoad [] --} - -- --------------------------------------------------------------------------- -- code for `:show' @@ -1258,6 +1276,7 @@ showCmd str = ["modules" ] -> showModules ["bindings"] -> showBindings ["linker"] -> io showLinkerState + ["breaks"] -> showBkptTable _ -> throwDyn (CmdLineError "syntax: :show [modules|bindings]") showModules = do @@ -1288,6 +1307,12 @@ cleanType ty = do then return ty else return $! GHC.dropForAlls ty +showBkptTable :: GHCi () +showBkptTable = do + activeBreaks <- getActiveBreakPoints + str <- showForUser $ ppr activeBreaks + io $ putStrLn str + -- ----------------------------------------------------------------------------- -- Completion @@ -1352,7 +1377,7 @@ completeModule w = do completeHomeModule w = do s <- restoreSession g <- GHC.getModuleGraph s - let home_mods = map GHC.ms_mod g + let home_mods = map GHC.ms_mod_name g return (filter (w `isPrefixOf`) (map (showSDoc.ppr) home_mods)) completeSetOptions w = do @@ -1382,15 +1407,15 @@ wrapCompleter fun w = do getCommonPrefix :: [String] -> String getCommonPrefix [] = "" getCommonPrefix (s:ss) = foldl common s ss - where common s "" = s + where common s "" = "" common "" s = "" common (c:cs) (d:ds) | c == d = c : common cs ds | otherwise = "" -allExposedModules :: DynFlags -> [Module] +allExposedModules :: DynFlags -> [ModuleName] allExposedModules dflags - = map GHC.mkModule (concat (map exposedModules (filter exposed (eltsUFM pkg_db)))) + = map GHC.mkModuleName (concat (map exposedModules (filter exposed (eltsUFM pkg_db)))) where pkg_db = pkgIdMap (pkgState dflags) #else @@ -1402,75 +1427,39 @@ completeHomeModule = completeNone completeSetOptions = completeNone completeFilename = completeNone completeHomeModuleOrFile=completeNone +completeBkpt = completeNone #endif ------------------------------------------------------------------------------ --- GHCi monad - -data GHCiState = GHCiState - { - progname :: String, - args :: [String], - prompt :: String, - session :: GHC.Session, - options :: [GHCiOption] - } - -data GHCiOption - = ShowTiming -- show time/allocs after evaluation - | ShowType -- show the type of expressions - | RevertCAFs -- revert CAFs after every evaluation - deriving Eq - -newtype GHCi a = GHCi { unGHCi :: IORef GHCiState -> IO a } - -startGHCi :: GHCi a -> GHCiState -> IO a -startGHCi g state = do ref <- newIORef state; unGHCi g ref - -instance Monad GHCi where - (GHCi m) >>= k = GHCi $ \s -> m s >>= \a -> unGHCi (k a) s - return a = GHCi $ \s -> return a - -ghciHandleDyn :: Typeable t => (t -> GHCi a) -> GHCi a -> GHCi a -ghciHandleDyn h (GHCi m) = GHCi $ \s -> - Exception.catchDyn (m s) (\e -> unGHCi (h e) s) - -getGHCiState = GHCi $ \r -> readIORef r -setGHCiState s = GHCi $ \r -> writeIORef r s - --- for convenience... -getSession = getGHCiState >>= return . session - -GLOBAL_VAR(saved_sess, no_saved_sess, Session) -no_saved_sess = error "no saved_ses" -saveSession = getSession >>= io . writeIORef saved_sess -splatSavedSession = io (writeIORef saved_sess no_saved_sess) -restoreSession = readIORef saved_sess - -getDynFlags = do - s <- getSession - io (GHC.getSessionDynFlags s) -setDynFlags dflags = do - s <- getSession - io (GHC.setSessionDynFlags s dflags) +-- --------------------------------------------------------------------------- +-- User code exception handling -isOptionSet :: GHCiOption -> GHCi Bool -isOptionSet opt - = do st <- getGHCiState - return (opt `elem` options st) +-- This is the exception handler for exceptions generated by the +-- user's code and exceptions coming from children sessions; +-- it normally just prints out the exception. The +-- handler must be recursive, in case showing the exception causes +-- more exceptions to be raised. +-- +-- Bugfix: if the user closed stdout or stderr, the flushing will fail, +-- raising another exception. We therefore don't put the recursive +-- handler arond the flushing operation, so if stderr is closed +-- GHCi will just die gracefully rather than going into an infinite loop. +handler :: Exception -> GHCi Bool -setOption :: GHCiOption -> GHCi () -setOption opt - = do st <- getGHCiState - setGHCiState (st{ options = opt : filter (/= opt) (options st) }) +handler exception = do + flushInterpBuffers + io installSignalHandlers + ghciHandle handler (showException exception >> return False) -unsetOption :: GHCiOption -> GHCi () -unsetOption opt - = do st <- getGHCiState - setGHCiState (st{ options = filter (/= opt) (options st) }) +showException (DynException dyn) = + case fromDynamic dyn of + Nothing -> io (putStrLn ("*** Exception: (unknown)")) + Just Interrupted -> io (putStrLn "Interrupted.") + Just (CmdLineError s) -> io (putStrLn s) -- omit the location for CmdLineError + Just ph@PhaseFailed{} -> io (putStrLn (showGhcException ph "")) -- ditto + Just other_ghc_ex -> io (print other_ghc_ex) -io :: IO a -> GHCi a -io m = GHCi { unGHCi = \s -> m >>= return } +showException other_exception + = io (putStrLn ("*** Exception: " ++ show other_exception)) ----------------------------------------------------------------------------- -- recursive exception handlers @@ -1487,48 +1476,8 @@ ghciHandle h (GHCi m) = GHCi $ \s -> ghciUnblock :: GHCi a -> GHCi a ghciUnblock (GHCi a) = GHCi $ \s -> Exception.unblock (a s) ------------------------------------------------------------------------------ --- timing & statistics - -timeIt :: GHCi a -> GHCi a -timeIt action - = do b <- isOptionSet ShowTiming - if not b - then action - else do allocs1 <- io $ getAllocations - time1 <- io $ getCPUTime - a <- action - allocs2 <- io $ getAllocations - time2 <- io $ getCPUTime - io $ printTimes (fromIntegral (allocs2 - allocs1)) - (time2 - time1) - return a - -foreign import ccall unsafe "getAllocations" getAllocations :: IO Int64 - -- defined in ghc/rts/Stats.c - -printTimes :: Integer -> Integer -> IO () -printTimes allocs psecs - = do let secs = (fromIntegral psecs / (10^12)) :: Float - secs_str = showFFloat (Just 2) secs - putStrLn (showSDoc ( - parens (text (secs_str "") <+> text "secs" <> comma <+> - text (show allocs) <+> text "bytes"))) - ------------------------------------------------------------------------------ --- reverting CAFs - -revertCAFs :: IO () -revertCAFs = do - rts_revertCAFs - turnOffBuffering - -- Have to turn off buffering again, because we just - -- reverted stdout, stderr & stdin to their defaults. -foreign import ccall "revertCAFs" rts_revertCAFs :: IO () - -- Make it "safe", just in case - --- ----------------------------------------------------------------------------- +-- ---------------------------------------------------------------------------- -- Utils expandPath :: String -> GHCi String @@ -1539,3 +1488,188 @@ expandPath path = return (tilde ++ '/':d) other -> return other + +-- ---------------------------------------------------------------------------- +-- Windows console setup + +setUpConsole :: IO () +setUpConsole = do +#ifdef mingw32_HOST_OS + -- On Windows we need to set a known code page, otherwise the characters + -- we read from the console will be be in some strange encoding, and + -- similarly for characters we write to the console. + -- + -- At the moment, GHCi pretends all input is Latin-1. In the + -- future we should support UTF-8, but for now we set the code pages + -- to Latin-1. + -- + -- It seems you have to set the font in the console window to + -- a Unicode font in order for output to work properly, + -- otherwise non-ASCII characters are mapped wrongly. sigh. + -- (see MSDN for SetConsoleOutputCP()). + -- + setConsoleCP 28591 -- ISO Latin-1 + setConsoleOutputCP 28591 -- ISO Latin-1 +#endif + return () + +-- commands for debugger +foreign import ccall "rts_setStepFlag" setStepFlag :: IO () + +stepCmd :: String -> GHCi Bool +stepCmd [] = doContinue setStepFlag +stepCmd expression = do + io $ setStepFlag + runCommand expression + +continueCmd :: String -> GHCi Bool +continueCmd [] = doContinue $ return () +continueCmd other = do + io $ putStrLn "The continue command accepts no arguments." + return False + +doContinue :: IO () -> GHCi Bool +doContinue actionBeforeCont = do + resumeAction <- getResume + popResume + case resumeAction of + Nothing -> do + io $ putStrLn "There is no computation running." + return False + Just action -> do + io $ actionBeforeCont + runResult <- io action + names <- switchOnRunResult runResult + finishEvalExpr names + return False + +deleteCmd :: String -> GHCi Bool +deleteCmd argLine = do + deleteSwitch $ words argLine + return False + where + deleteSwitch :: [String] -> GHCi () + deleteSwitch [] = + io $ putStrLn "The delete command requires at least one argument." + -- delete all break points + deleteSwitch ("*":_rest) = clearActiveBreakPoints + deleteSwitch idents = do + mapM_ deleteOneBreak idents + where + deleteOneBreak :: String -> GHCi () + deleteOneBreak str + | all isDigit str = deleteBreak (read str) + | otherwise = return () + +-- handle the "break" command +breakCmd :: String -> GHCi Bool +breakCmd argLine = do + session <- getSession + breakSwitch session $ words argLine + +breakSwitch :: Session -> [String] -> GHCi Bool +breakSwitch _session [] = do + io $ putStrLn "The break command requires at least one argument." + return False +breakSwitch session args@(arg1:rest) + | looksLikeModule arg1 = do + mod <- lookupModule session arg1 + breakByModule mod rest + return False + | otherwise = do + (toplevel, _) <- io $ GHC.getContext session + case toplevel of + (mod : _) -> breakByModule mod args + [] -> 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 + +breakByModule :: Module -> [String] -> GHCi () +breakByModule 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` "~!@#$%^&*-+" + +breakByModuleLine :: Module -> Int -> [String] -> GHCi () +breakByModuleLine mod line args + | [] <- args = findBreakAndSet mod $ lookupTickTreeLine line + | [col] <- args, all isDigit col = + findBreakAndSet mod $ lookupTickTreeCoord (line, read col) + | otherwise = io $ putStrLn "Invalid arguments to break command." + +findBreakAndSet :: Module -> (TickTree -> Maybe (Int, SrcSpan)) -> GHCi () +findBreakAndSet mod lookupTickTree = do + (breakArray, ticks) <- getModBreak mod + let tickTree = tickTreeFromList (assocs ticks) + case lookupTickTree tickTree of + Nothing -> io $ putStrLn $ "No breakpoints found at that location." + Just (tick, span) -> do + success <- io $ setBreakFlag True breakArray tick + session <- getSession + unqual <- io $ GHC.getPrintUnqual session + if success + then do + (alreadySet, nm) <- + recordBreak $ BreakLocation + { breakModule = mod + , breakLoc = span + , breakTick = tick + } + io $ printForUser stdout unqual $ + text "Breakpoint " <> ppr nm <> + if alreadySet + then text " was already set at " <> ppr span + else text " activated at " <> ppr span + else do + str <- showForUser $ text "Breakpoint could not be activated at" + <+> ppr span + io $ putStrLn str + +getModBreak :: Module -> GHCi (BreakArray, Array Int SrcSpan) +getModBreak mod = do + session <- getSession + Just mod_info <- io $ GHC.getModuleInfo session mod + let modBreaks = GHC.modInfoModBreaks mod_info + let array = modBreaks_array modBreaks + let ticks = modBreaks_ticks modBreaks + return (array, ticks) + +lookupModule :: Session -> String -> GHCi Module +lookupModule session modName + = io (GHC.findModule session (GHC.mkModuleName modName) Nothing) + +setBreakFlag :: Bool -> BreakArray -> Int -> IO Bool +setBreakFlag toggle array index + | toggle = setBreakOn array index + | otherwise = setBreakOff array index + + +{- these should probably go to the GHC API at some point -} +enableBreakPoint :: Session -> Module -> Int -> IO () +enableBreakPoint session mod index = return () + +disableBreakPoint :: Session -> Module -> Int -> IO () +disableBreakPoint session mod index = return () + +activeBreakPoints :: Session -> IO [(Module,Int)] +activeBreakPoints session = return [] + +enableSingleStep :: Session -> IO () +enableSingleStep session = return () + +disableSingleStep :: Session -> IO () +disableSingleStep session = return ()