compiler/ghci/InteractiveUI.hs

   1 {-# OPTIONS -#include "Linker.h" #-}
   2 -----------------------------------------------------------------------------
   3 --
   4 -- GHC Interactive User Interface
   5 --
   6 -- (c) The GHC Team 2005-2006
   7 --
   8 -----------------------------------------------------------------------------
   9 module InteractiveUI (
  10         interactiveUI,
  11         ghciWelcomeMsg
  12    ) where
  13
  14 #include "HsVersions.h"
  15
  16 import GhciMonad
  17
  18 -- The GHC interface
  19 import qualified GHC
  20 import GHC              ( Session, LoadHowMuch(..), Target(..),  TargetId(..),
  21                           Type, Module, ModuleName, TyThing(..), Phase,
  22                           BreakIndex )
  23 import Debugger
  24 import DynFlags
  25 import Packages
  26 import PackageConfig
  27 import UniqFM
  28 import PprTyThing
  29 import Outputable       hiding (printForUser)
  30 import Module           -- for ModuleEnv
  31
  32 -- for createtags
  33 import Name
  34 import OccName
  35 import SrcLoc
  36
  37 -- Other random utilities
  38 import Digraph
  39 import BasicTypes hiding (isTopLevel)
  40 import Panic      hiding (showException)
  41 import FastString       ( unpackFS )
  42 import Config
  43 import StaticFlags
  44 import Linker
  45 import Util
  46
  47 #ifndef mingw32_HOST_OS
  48 import System.Posix
  49 #if __GLASGOW_HASKELL__ > 504
  50         hiding (getEnv)
  51 #endif
  52 #else
  53 import GHC.ConsoleHandler ( flushConsole )
  54 import System.Win32       ( setConsoleCP, setConsoleOutputCP )
  55 import qualified System.Win32
  56 #endif
  57
  58 #ifdef USE_READLINE
  59 import Control.Concurrent       ( yield )       -- Used in readline loop
  60 import System.Console.Readline as Readline
  61 #endif
  62
  63 --import SystemExts
  64
  65 import Control.Exception as Exception
  66 -- import Control.Concurrent
  67
  68 import qualified Data.ByteString.Char8 as BS
  69 import Data.List
  70 import Data.Maybe
  71 import System.Cmd
  72 import System.Environment
  73 import System.Exit      ( exitWith, ExitCode(..) )
  74 import System.Directory
  75 import System.IO
  76 import System.IO.Error as IO
  77 import Data.Char
  78 import Data.Dynamic
  79 import Data.Array
  80 import Control.Monad as Monad
  81
  82 import Foreign.StablePtr        ( newStablePtr )
  83 import GHC.Exts         ( unsafeCoerce# )
  84 import GHC.IOBase       ( IOErrorType(InvalidArgument) )
  85
  86 import Data.IORef       ( IORef, readIORef, writeIORef )
  87
  88 import System.Posix.Internals ( setNonBlockingFD )
  89
  90 -----------------------------------------------------------------------------
  91
  92 ghciWelcomeMsg =
  93  "   ___         ___ _\n"++
  94  "  / _ \\ /\\  /\\/ __(_)\n"++
  95  " / /_\\// /_/ / /  | |      GHC Interactive, version " ++ cProjectVersion ++ ", for Haskell 98.\n"++
  96  "/ /_\\\\/ __  / /___| |      http://www.haskell.org/ghc/\n"++
  97  "\\____/\\/ /_/\\____/|_|      Type :? for help.\n"
  98
  99 type Command = (String, String -> GHCi Bool, Bool, String -> IO [String])
 100 cmdName (n,_,_,_) = n
 101
 102 GLOBAL_VAR(commands, builtin_commands, [Command])
 103
 104 builtin_commands :: [Command]
 105 builtin_commands = [
 106         -- Hugs users are accustomed to :e, so make sure it doesn't overlap
 107   ("?",         keepGoing help,                 False, completeNone),
 108   ("add",       keepGoingPaths addModule,       False, completeFilename),
 109   ("break",     keepGoing breakCmd,             False, completeIdentifier),
 110   ("browse",    keepGoing browseCmd,            False, completeModule),
 111   ("cd",        keepGoing changeDirectory,      False, completeFilename),
 112   ("check",     keepGoing checkModule,          False, completeHomeModule),
 113   ("continue",  continueCmd,                    False, completeNone),
 114   ("ctags",     keepGoing createCTagsFileCmd,   False, completeFilename),
 115   ("def",       keepGoing defineMacro,          False, completeIdentifier),
 116   ("delete",    keepGoing deleteCmd,            False, completeNone),
 117   ("e",         keepGoing editFile,             False, completeFilename),
 118   ("edit",      keepGoing editFile,             False, completeFilename),
 119   ("etags",     keepGoing createETagsFileCmd,   False, completeFilename),
 120   ("force",     keepGoing (pprintClosureCommand False True), False, completeIdentifier),
 121   ("help",      keepGoing help,                 False, completeNone),
 122   ("info",      keepGoing info,                 False, completeIdentifier),
 123   ("kind",      keepGoing kindOfType,           False, completeIdentifier),
 124   ("load",      keepGoingPaths loadModule_,     False, completeHomeModuleOrFile),
 125   ("list",      keepGoing listCmd,              False, completeNone),
 126   ("module",    keepGoing setContext,           False, completeModule),
 127   ("main",      keepGoing runMain,              False, completeIdentifier),
 128   ("print",     keepGoing (pprintClosureCommand True False), False, completeIdentifier),
 129   ("quit",      quit,                           False, completeNone),
 130   ("reload",    keepGoing reloadModule,         False, completeNone),
 131   ("set",       keepGoing setCmd,               True,  completeSetOptions),
 132   ("show",      keepGoing showCmd,              False, completeNone),
 133   ("sprint",    keepGoing (pprintClosureCommand False False),False, completeIdentifier),
 134   ("step",      stepCmd,                        False, completeIdentifier),
 135   ("type",      keepGoing typeOfExpr,           False, completeIdentifier),
 136   ("undef",     keepGoing undefineMacro,        False, completeMacro),
 137   ("unset",     keepGoing unsetOptions,         True,  completeSetOptions)
 138   ]
 139
 140 keepGoing :: (String -> GHCi ()) -> (String -> GHCi Bool)
 141 keepGoing a str = a str >> return False
 142
 143 keepGoingPaths :: ([FilePath] -> GHCi ()) -> (String -> GHCi Bool)
 144 keepGoingPaths a str = a (toArgs str) >> return False
 145
 146 shortHelpText = "use :? for help.\n"
 147
 148 helpText =
 149  " Commands available from the prompt:\n" ++
 150  "\n" ++
 151  "   <stmt>                      evaluate/run <stmt>\n" ++
 152  "   :add <filename> ...         add module(s) to the current target set\n" ++
 153  "   :break [<mod>] <l> [<col>]  set a breakpoint at the specified location\n" ++
 154  "   :break <name>               set a breakpoint on the specified function\n" ++
 155  "   :browse [*]<module>         display the names defined by <module>\n" ++
 156  "   :cd <dir>                   change directory to <dir>\n" ++
 157  "   :continue                   resume after a breakpoint\n" ++
 158  "   :ctags [<file>]             create tags file for Vi (default: \"tags\")\n" ++
 159  "   :def <cmd> <expr>           define a command :<cmd>\n" ++
 160  "   :delete <number>            delete the specified breakpoint\n" ++
 161  "   :delete *                   delete all breakpoints\n" ++
 162  "   :edit <file>                edit file\n" ++
 163  "   :edit                       edit last module\n" ++
 164  "   :etags [<file>]             create tags file for Emacs (default: \"TAGS\")\n" ++
 165 -- "   :force <expr>               print <expr>, forcing unevaluated parts\n" ++
 166  "   :help, :?                   display this list of commands\n" ++
 167  "   :info [<name> ...]          display information about the given names\n" ++
 168  "   :kind <type>                show the kind of <type>\n" ++
 169  "   :load <filename> ...        load module(s) and their dependents\n" ++
 170  "   :module [+/-] [*]<mod> ...  set the context for expression evaluation\n" ++
 171  "   :main [<arguments> ...]     run the main function with the given arguments\n" ++
 172  "   :print [<name> ...]         prints a value without forcing its computation\n" ++
 173  "   :quit                       exit GHCi\n" ++
 174  "   :reload                     reload the current module set\n" ++
 175  "\n" ++
 176  "   :set <option> ...           set options\n" ++
 177  "   :set args <arg> ...         set the arguments returned by System.getArgs\n" ++
 178  "   :set prog <progname>        set the value returned by System.getProgName\n" ++
 179  "   :set prompt <prompt>        set the prompt used in GHCi\n" ++
 180  "   :set editor <cmd>           set the command used for :edit\n" ++
 181  "   :set stop <cmd>             set the command to run when a breakpoint is hit\n" ++
 182  "\n" ++
 183  "   :show breaks                show active breakpoints\n" ++
 184  "   :show context               show the breakpoint context\n" ++
 185  "   :show modules               show the currently loaded modules\n" ++
 186  "   :show bindings              show the current bindings made at the prompt\n" ++
 187  "\n" ++
 188  "   :sprint [<name> ...]        simplifed version of :print\n" ++
 189  "   :step                       single-step after stopping at a breakpoint\n"++
 190  "   :step <expr>                single-step into <expr>\n"++
 191  "   :type <expr>                show the type of <expr>\n" ++
 192  "   :undef <cmd>                undefine user-defined command :<cmd>\n" ++
 193  "   :unset <option> ...         unset options\n" ++
 194  "   :!<command>                 run the shell command <command>\n" ++
 195  "\n" ++
 196  " Options for ':set' and ':unset':\n" ++
 197  "\n" ++
 198  "    +r            revert top-level expressions after each evaluation\n" ++
 199  "    +s            print timing/memory stats after each evaluation\n" ++
 200  "    +t            print type after evaluation\n" ++
 201  "    -<flags>      most GHC command line flags can also be set here\n" ++
 202  "                         (eg. -v2, -fglasgow-exts, etc.)\n" ++
 203  "\n"
 204 -- Todo: add help for breakpoint commands here
 205
 206 findEditor = do
 207   getEnv "EDITOR"
 208     `IO.catch` \_ -> do
 209 #if mingw32_HOST_OS
 210         win <- System.Win32.getWindowsDirectory
 211         return (win `joinFileName` "notepad.exe")
 212 #else
 213         return ""
 214 #endif
 215
 216 interactiveUI :: Session -> [(FilePath, Maybe Phase)] -> Maybe String -> IO ()
 217 interactiveUI session srcs maybe_expr = do
 218    -- HACK! If we happen to get into an infinite loop (eg the user
 219    -- types 'let x=x in x' at the prompt), then the thread will block
 220    -- on a blackhole, and become unreachable during GC.  The GC will
 221    -- detect that it is unreachable and send it the NonTermination
 222    -- exception.  However, since the thread is unreachable, everything
 223    -- it refers to might be finalized, including the standard Handles.
 224    -- This sounds like a bug, but we don't have a good solution right
 225    -- now.
 226    newStablePtr stdin
 227    newStablePtr stdout
 228    newStablePtr stderr
 229
 230         -- Initialise buffering for the *interpreted* I/O system
 231    initInterpBuffering session
 232
 233    when (isNothing maybe_expr) $ do
 234         -- Only for GHCi (not runghc and ghc -e):
 235         -- Turn buffering off for the compiled program's stdout/stderr
 236         turnOffBuffering
 237         -- Turn buffering off for GHCi's stdout
 238         hFlush stdout
 239         hSetBuffering stdout NoBuffering
 240         -- We don't want the cmd line to buffer any input that might be
 241         -- intended for the program, so unbuffer stdin.
 242         hSetBuffering stdin NoBuffering
 243
 244         -- initial context is just the Prelude
 245    prel_mod <- GHC.findModule session prel_name (Just basePackageId)
 246    GHC.setContext session [] [prel_mod]
 247
 248 #ifdef USE_READLINE
 249    Readline.initialize
 250    Readline.setAttemptedCompletionFunction (Just completeWord)
 251    --Readline.parseAndBind "set show-all-if-ambiguous 1"
 252
 253    let symbols = "!#$%&*+/<=>?@\\^|-~"
 254        specials = "(),;[]`{}"
 255        spaces = " \t\n"
 256        word_break_chars = spaces ++ specials ++ symbols
 257
 258    Readline.setBasicWordBreakCharacters word_break_chars
 259    Readline.setCompleterWordBreakCharacters word_break_chars
 260 #endif
 261
 262    default_editor <- findEditor
 263
 264    startGHCi (runGHCi srcs maybe_expr)
 265         GHCiState{ progname = "<interactive>",
 266                    args = [],
 267                    prompt = "%s> ",
 268                    stop = "",
 269                    editor = default_editor,
 270                    session = session,
 271                    options = [],
 272                    prelude = prel_mod,
 273                    resume = [],
 274                    breaks = emptyActiveBreakPoints,
 275                    tickarrays = emptyModuleEnv
 276                  }
 277
 278 #ifdef USE_READLINE
 279    Readline.resetTerminal Nothing
 280 #endif
 281
 282    return ()
 283
 284 prel_name = GHC.mkModuleName "Prelude"
 285
 286 runGHCi :: [(FilePath, Maybe Phase)] -> Maybe String -> GHCi ()
 287 runGHCi paths maybe_expr = do
 288   let read_dot_files = not opt_IgnoreDotGhci
 289
 290   when (read_dot_files) $ do
 291     -- Read in ./.ghci.
 292     let file = "./.ghci"
 293     exists <- io (doesFileExist file)
 294     when exists $ do
 295        dir_ok  <- io (checkPerms ".")
 296        file_ok <- io (checkPerms file)
 297        when (dir_ok && file_ok) $ do
 298           either_hdl <- io (IO.try (openFile "./.ghci" ReadMode))
 299           case either_hdl of
 300              Left e    -> return ()
 301              Right hdl -> fileLoop hdl False
 302
 303   when (read_dot_files) $ do
 304     -- Read in $HOME/.ghci
 305     either_dir <- io (IO.try (getEnv "HOME"))
 306     case either_dir of
 307        Left e -> return ()
 308        Right dir -> do
 309           cwd <- io (getCurrentDirectory)
 310           when (dir /= cwd) $ do
 311              let file = dir ++ "/.ghci"
 312              ok <- io (checkPerms file)
 313              when ok $ do
 314                either_hdl <- io (IO.try (openFile file ReadMode))
 315                case either_hdl of
 316                   Left e    -> return ()
 317                   Right hdl -> fileLoop hdl False
 318
 319   -- Perform a :load for files given on the GHCi command line
 320   -- When in -e mode, if the load fails then we want to stop
 321   -- immediately rather than going on to evaluate the expression.
 322   when (not (null paths)) $ do
 323      ok <- ghciHandle (\e -> do showException e; return Failed) $
 324                 loadModule paths
 325      when (isJust maybe_expr && failed ok) $
 326         io (exitWith (ExitFailure 1))
 327
 328   -- if verbosity is greater than 0, or we are connected to a
 329   -- terminal, display the prompt in the interactive loop.
 330   is_tty <- io (hIsTerminalDevice stdin)
 331   dflags <- getDynFlags
 332   let show_prompt = verbosity dflags > 0 || is_tty
 333
 334   case maybe_expr of
 335         Nothing ->
 336           do
 337 #if defined(mingw32_HOST_OS)
 338             -- The win32 Console API mutates the first character of
 339             -- type-ahead when reading from it in a non-buffered manner. Work
 340             -- around this by flushing the input buffer of type-ahead characters,
 341             -- but only if stdin is available.
 342             flushed <- io (IO.try (GHC.ConsoleHandler.flushConsole stdin))
 343             case flushed of
 344              Left err | isDoesNotExistError err -> return ()
 345                       | otherwise -> io (ioError err)
 346              Right () -> return ()
 347 #endif
 348             -- initialise the console if necessary
 349             io setUpConsole
 350
 351             -- enter the interactive loop
 352             interactiveLoop is_tty show_prompt
 353         Just expr -> do
 354             -- just evaluate the expression we were given
 355             runCommandEval expr
 356             return ()
 357
 358   -- and finally, exit
 359   io $ do when (verbosity dflags > 0) $ putStrLn "Leaving GHCi."
 360
 361
 362 interactiveLoop is_tty show_prompt =
 363   -- Ignore ^C exceptions caught here
 364   ghciHandleDyn (\e -> case e of
 365                         Interrupted -> do
 366 #if defined(mingw32_HOST_OS)
 367                                 io (putStrLn "")
 368 #endif
 369                                 interactiveLoop is_tty show_prompt
 370                         _other      -> return ()) $
 371
 372   ghciUnblock $ do -- unblock necessary if we recursed from the
 373                    -- exception handler above.
 374
 375   -- read commands from stdin
 376 #ifdef USE_READLINE
 377   if (is_tty)
 378         then readlineLoop
 379         else fileLoop stdin show_prompt
 380 #else
 381   fileLoop stdin show_prompt
 382 #endif
 383
 384
 385 -- NOTE: We only read .ghci files if they are owned by the current user,
 386 -- and aren't world writable.  Otherwise, we could be accidentally
 387 -- running code planted by a malicious third party.
 388
 389 -- Furthermore, We only read ./.ghci if . is owned by the current user
 390 -- and isn't writable by anyone else.  I think this is sufficient: we
 391 -- don't need to check .. and ../.. etc. because "."  always refers to
 392 -- the same directory while a process is running.
 393
 394 checkPerms :: String -> IO Bool
 395 checkPerms name =
 396 #ifdef mingw32_HOST_OS
 397   return True
 398 #else
 399   Util.handle (\_ -> return False) $ do
 400      st <- getFileStatus name
 401      me <- getRealUserID
 402      if fileOwner st /= me then do
 403         putStrLn $ "WARNING: " ++ name ++ " is owned by someone else, IGNORING!"
 404         return False
 405       else do
 406         let mode =  fileMode st
 407         if (groupWriteMode == (mode `intersectFileModes` groupWriteMode))
 408            || (otherWriteMode == (mode `intersectFileModes` otherWriteMode))
 409            then do
 410                putStrLn $ "*** WARNING: " ++ name ++
 411                           " is writable by someone else, IGNORING!"
 412                return False
 413           else return True
 414 #endif
 415
 416 fileLoop :: Handle -> Bool -> GHCi ()
 417 fileLoop hdl show_prompt = do
 418    session <- getSession
 419    (mod,imports) <- io (GHC.getContext session)
 420    st <- getGHCiState
 421    when show_prompt (io (putStr (mkPrompt mod imports (prompt st))))
 422    l <- io (IO.try (hGetLine hdl))
 423    case l of
 424         Left e | isEOFError e              -> return ()
 425                | InvalidArgument <- etype  -> return ()
 426                | otherwise                 -> io (ioError e)
 427                 where etype = ioeGetErrorType e
 428                 -- treat InvalidArgument in the same way as EOF:
 429                 -- this can happen if the user closed stdin, or
 430                 -- perhaps did getContents which closes stdin at
 431                 -- EOF.
 432         Right l ->
 433           case removeSpaces l of
 434             "" -> fileLoop hdl show_prompt
 435             l  -> do quit <- runCommand l
 436                      if quit then return () else fileLoop hdl show_prompt
 437
 438 stringLoop :: [String] -> GHCi Bool{-True: we quit-}
 439 stringLoop [] = return False
 440 stringLoop (s:ss) = do
 441    case removeSpaces s of
 442         "" -> stringLoop ss
 443         l  -> do quit <- runCommand l
 444                  if quit then return True else stringLoop ss
 445
 446 mkPrompt toplevs exports prompt
 447   = showSDoc $ f prompt
 448     where
 449         f ('%':'s':xs) = perc_s <> f xs
 450         f ('%':'%':xs) = char '%' <> f xs
 451         f (x:xs) = char x <> f xs
 452         f [] = empty
 453
 454         perc_s = hsep (map (\m -> char '*' <> ppr (GHC.moduleName m)) toplevs) <+>
 455                  hsep (map (ppr . GHC.moduleName) exports)
 456
 457
 458 #ifdef USE_READLINE
 459 readlineLoop :: GHCi ()
 460 readlineLoop = do
 461    session <- getSession
 462    (mod,imports) <- io (GHC.getContext session)
 463    io yield
 464    saveSession -- for use by completion
 465    st <- getGHCiState
 466    l <- io (readline (mkPrompt mod imports (prompt st))
 467                 `finally` setNonBlockingFD 0)
 468                 -- readline sometimes puts stdin into blocking mode,
 469                 -- so we need to put it back for the IO library
 470    splatSavedSession
 471    case l of
 472         Nothing -> return ()
 473         Just l  ->
 474           case removeSpaces l of
 475             "" -> readlineLoop
 476             l  -> do
 477                   io (addHistory l)
 478                   quit <- runCommand l
 479                   if quit then return () else readlineLoop
 480 #endif
 481
 482 runCommand :: String -> GHCi Bool
 483 runCommand c = ghciHandle handler (doCommand c)
 484   where
 485     doCommand (':' : command) = specialCommand command
 486     doCommand stmt
 487        = do timeIt (do nms <- runStmt stmt; finishEvalExpr nms)
 488             return False
 489
 490 -- This version is for the GHC command-line option -e.  The only difference
 491 -- from runCommand is that it catches the ExitException exception and
 492 -- exits, rather than printing out the exception.
 493 runCommandEval c = ghciHandle handleEval (doCommand c)
 494   where
 495     handleEval (ExitException code) = io (exitWith code)
 496     handleEval e                    = do handler e
 497                                          io (exitWith (ExitFailure 1))
 498
 499     doCommand (':' : command) = specialCommand command
 500     doCommand stmt
 501        = do nms <- runStmt stmt
 502             case nms of
 503                 Nothing -> io (exitWith (ExitFailure 1))
 504                   -- failure to run the command causes exit(1) for ghc -e.
 505                 _       -> do finishEvalExpr nms
 506                               return True
 507
 508 runStmt :: String -> GHCi (Maybe (Bool,[Name]))
 509 runStmt stmt
 510  | null (filter (not.isSpace) stmt) = return (Just (False,[]))
 511  | otherwise
 512  = do st <- getGHCiState
 513       session <- getSession
 514       result <- io $ withProgName (progname st) $ withArgs (args st) $
 515                      GHC.runStmt session stmt
 516       switchOnRunResult result
 517
 518 switchOnRunResult :: GHC.RunResult -> GHCi (Maybe (Bool,[Name]))
 519 switchOnRunResult GHC.RunFailed = return Nothing
 520 switchOnRunResult (GHC.RunException e) = throw e
 521 switchOnRunResult (GHC.RunOk names) = return $ Just (False,names)
 522 switchOnRunResult (GHC.RunBreak threadId names info resume) = do
 523    session <- getSession
 524    Just mod_info <- io $ GHC.getModuleInfo session (GHC.breakInfo_module info)
 525    let modBreaks  = GHC.modInfoModBreaks mod_info
 526    let ticks      = GHC.modBreaks_locs modBreaks
 527
 528    -- display information about the breakpoint
 529    let location = ticks ! GHC.breakInfo_number info
 530    printForUser $ ptext SLIT("Stopped at") <+> ppr location
 531
 532    pushResume location threadId resume
 533
 534    -- run the command set with ":set stop <cmd>"
 535    st <- getGHCiState
 536    runCommand (stop st)
 537
 538    return (Just (True,names))
 539
 540 -- possibly print the type and revert CAFs after evaluating an expression
 541 finishEvalExpr mb_names
 542  = do show_types <- isOptionSet ShowType
 543       session <- getSession
 544       case mb_names of
 545         Nothing    -> return ()
 546         Just (is_break,names) ->
 547                 when (is_break || show_types) $
 548                       mapM_ (showTypeOfName session) names
 549
 550       flushInterpBuffers
 551       io installSignalHandlers
 552       b <- isOptionSet RevertCAFs
 553       io (when b revertCAFs)
 554
 555 showTypeOfName :: Session -> Name -> GHCi ()
 556 showTypeOfName session n
 557    = do maybe_tything <- io (GHC.lookupName session n)
 558         case maybe_tything of
 559           Nothing    -> return ()
 560           Just thing -> showTyThing thing
 561
 562 specialCommand :: String -> GHCi Bool
 563 specialCommand ('!':str) = shellEscape (dropWhile isSpace str)
 564 specialCommand str = do
 565   let (cmd,rest) = break isSpace str
 566   maybe_cmd <- io (lookupCommand cmd)
 567   case maybe_cmd of
 568     Nothing -> io (hPutStr stdout ("unknown command ':" ++ cmd ++ "'\n"
 569                                     ++ shortHelpText) >> return False)
 570     Just (_,f,_,_) -> f (dropWhile isSpace rest)
 571
 572 lookupCommand :: String -> IO (Maybe Command)
 573 lookupCommand str = do
 574   cmds <- readIORef commands
 575   -- look for exact match first, then the first prefix match
 576   case [ c | c <- cmds, str == cmdName c ] of
 577      c:_ -> return (Just c)
 578      [] -> case [ c | c@(s,_,_,_) <- cmds, prefixMatch str s ] of
 579                 [] -> return Nothing
 580                 c:_ -> return (Just c)
 581
 582 -----------------------------------------------------------------------------
 583 -- Commands
 584
 585 help :: String -> GHCi ()
 586 help _ = io (putStr helpText)
 587
 588 info :: String -> GHCi ()
 589 info "" = throwDyn (CmdLineError "syntax: ':i <thing-you-want-info-about>'")
 590 info s  = do { let names = words s
 591              ; session <- getSession
 592              ; dflags <- getDynFlags
 593              ; let exts = dopt Opt_GlasgowExts dflags
 594              ; mapM_ (infoThing exts session) names }
 595   where
 596     infoThing exts session str = io $ do
 597         names <- GHC.parseName session str
 598         let filtered = filterOutChildren names
 599         mb_stuffs <- mapM (GHC.getInfo session) filtered
 600         unqual <- GHC.getPrintUnqual session
 601         putStrLn (showSDocForUser unqual $
 602                    vcat (intersperse (text "") $
 603                    [ pprInfo exts stuff | Just stuff <-  mb_stuffs ]))
 604
 605   -- Filter out names whose parent is also there Good
 606   -- example is '[]', which is both a type and data
 607   -- constructor in the same type
 608 filterOutChildren :: [Name] -> [Name]
 609 filterOutChildren names = filter (not . parent_is_there) names
 610  where parent_is_there n
 611 --       | Just p <- GHC.nameParent_maybe n = p `elem` names
 612 -- ToDo!!
 613          | otherwise                       = False
 614
 615 pprInfo exts (thing, fixity, insts)
 616   =  pprTyThingInContextLoc exts thing
 617   $$ show_fixity fixity
 618   $$ vcat (map GHC.pprInstance insts)
 619   where
 620     show_fixity fix
 621         | fix == GHC.defaultFixity = empty
 622         | otherwise                = ppr fix <+> ppr (GHC.getName thing)
 623
 624 -----------------------------------------------------------------------------
 625 -- Commands
 626
 627 runMain :: String -> GHCi ()
 628 runMain args = do
 629   let ss = concat $ intersperse "," (map (\ s -> ('"':s)++"\"") (toArgs args))
 630   runCommand $ '[': ss ++ "] `System.Environment.withArgs` main"
 631   return ()
 632
 633 addModule :: [FilePath] -> GHCi ()
 634 addModule files = do
 635   io (revertCAFs)                       -- always revert CAFs on load/add.
 636   files <- mapM expandPath files
 637   targets <- mapM (\m -> io (GHC.guessTarget m Nothing)) files
 638   session <- getSession
 639   io (mapM_ (GHC.addTarget session) targets)
 640   ok <- io (GHC.load session LoadAllTargets)
 641   afterLoad ok session
 642
 643 changeDirectory :: String -> GHCi ()
 644 changeDirectory dir = do
 645   session <- getSession
 646   graph <- io (GHC.getModuleGraph session)
 647   when (not (null graph)) $
 648         io $ putStr "Warning: changing directory causes all loaded modules to be unloaded,\nbecause the search path has changed.\n"
 649   io (GHC.setTargets session [])
 650   io (GHC.load session LoadAllTargets)
 651   setContextAfterLoad session []
 652   io (GHC.workingDirectoryChanged session)
 653   dir <- expandPath dir
 654   io (setCurrentDirectory dir)
 655
 656 editFile :: String -> GHCi ()
 657 editFile str
 658   | null str  = do
 659         -- find the name of the "topmost" file loaded
 660      session <- getSession
 661      graph0 <- io (GHC.getModuleGraph session)
 662      graph1 <- filterM (io . GHC.isLoaded session . GHC.ms_mod_name) graph0
 663      let graph2 = flattenSCCs (GHC.topSortModuleGraph True graph1 Nothing)
 664      case GHC.ml_hs_file (GHC.ms_location (last graph2)) of
 665         Just file -> do_edit file
 666         Nothing   -> throwDyn (CmdLineError "unknown file name")
 667   | otherwise = do_edit str
 668   where
 669         do_edit file = do
 670            st <- getGHCiState
 671            let cmd = editor st
 672            when (null cmd) $
 673                 throwDyn (CmdLineError "editor not set, use :set editor")
 674            io $ system (cmd ++ ' ':file)
 675            return ()
 676
 677 defineMacro :: String -> GHCi ()
 678 defineMacro s = do
 679   let (macro_name, definition) = break isSpace s
 680   cmds <- io (readIORef commands)
 681   if (null macro_name)
 682         then throwDyn (CmdLineError "invalid macro name")
 683         else do
 684   if (macro_name `elem` map cmdName cmds)
 685         then throwDyn (CmdLineError
 686                 ("command '" ++ macro_name ++ "' is already defined"))
 687         else do
 688
 689   -- give the expression a type signature, so we can be sure we're getting
 690   -- something of the right type.
 691   let new_expr = '(' : definition ++ ") :: String -> IO String"
 692
 693   -- compile the expression
 694   cms <- getSession
 695   maybe_hv <- io (GHC.compileExpr cms new_expr)
 696   case maybe_hv of
 697      Nothing -> return ()
 698      Just hv -> io (writeIORef commands --
 699                     (cmds ++ [(macro_name, runMacro hv, False, completeNone)]))
 700
 701 runMacro :: GHC.HValue{-String -> IO String-} -> String -> GHCi Bool
 702 runMacro fun s = do
 703   str <- io ((unsafeCoerce# fun :: String -> IO String) s)
 704   stringLoop (lines str)
 705
 706 undefineMacro :: String -> GHCi ()
 707 undefineMacro macro_name = do
 708   cmds <- io (readIORef commands)
 709   if (macro_name `elem` map cmdName builtin_commands)
 710         then throwDyn (CmdLineError
 711                 ("command '" ++ macro_name ++ "' cannot be undefined"))
 712         else do
 713   if (macro_name `notElem` map cmdName cmds)
 714         then throwDyn (CmdLineError
 715                 ("command '" ++ macro_name ++ "' not defined"))
 716         else do
 717   io (writeIORef commands (filter ((/= macro_name) . cmdName) cmds))
 718
 719
 720 loadModule :: [(FilePath, Maybe Phase)] -> GHCi SuccessFlag
 721 loadModule fs = timeIt (loadModule' fs)
 722
 723 loadModule_ :: [FilePath] -> GHCi ()
 724 loadModule_ fs = do loadModule (zip fs (repeat Nothing)); return ()
 725
 726 loadModule' :: [(FilePath, Maybe Phase)] -> GHCi SuccessFlag
 727 loadModule' files = do
 728   session <- getSession
 729
 730   -- unload first
 731   io (GHC.setTargets session [])
 732   io (GHC.load session LoadAllTargets)
 733
 734   -- expand tildes
 735   let (filenames, phases) = unzip files
 736   exp_filenames <- mapM expandPath filenames
 737   let files' = zip exp_filenames phases
 738   targets <- io (mapM (uncurry GHC.guessTarget) files')
 739
 740   -- NOTE: we used to do the dependency anal first, so that if it
 741   -- fails we didn't throw away the current set of modules.  This would
 742   -- require some re-working of the GHC interface, so we'll leave it
 743   -- as a ToDo for now.
 744
 745   io (GHC.setTargets session targets)
 746   ok <- io (GHC.load session LoadAllTargets)
 747   afterLoad ok session
 748   return ok
 749
 750 checkModule :: String -> GHCi ()
 751 checkModule m = do
 752   let modl = GHC.mkModuleName m
 753   session <- getSession
 754   result <- io (GHC.checkModule session modl)
 755   case result of
 756     Nothing -> io $ putStrLn "Nothing"
 757     Just r  -> io $ putStrLn (showSDoc (
 758         case GHC.checkedModuleInfo r of
 759            Just cm | Just scope <- GHC.modInfoTopLevelScope cm ->
 760                 let
 761                     (local,global) = partition ((== modl) . GHC.moduleName . GHC.nameModule) scope
 762                 in
 763                         (text "global names: " <+> ppr global) $$
 764                         (text "local  names: " <+> ppr local)
 765            _ -> empty))
 766   afterLoad (successIf (isJust result)) session
 767
 768 reloadModule :: String -> GHCi ()
 769 reloadModule "" = do
 770   io (revertCAFs)               -- always revert CAFs on reload.
 771   session <- getSession
 772   ok <- io (GHC.load session LoadAllTargets)
 773   afterLoad ok session
 774 reloadModule m = do
 775   io (revertCAFs)               -- always revert CAFs on reload.
 776   session <- getSession
 777   ok <- io (GHC.load session (LoadUpTo (GHC.mkModuleName m)))
 778   afterLoad ok session
 779
 780 afterLoad ok session = do
 781   io (revertCAFs)  -- always revert CAFs on load.
 782   discardResumeContext
 783   discardTickArrays
 784   discardActiveBreakPoints
 785   graph <- io (GHC.getModuleGraph session)
 786   graph' <- filterM (io . GHC.isLoaded session . GHC.ms_mod_name) graph
 787   setContextAfterLoad session graph'
 788   modulesLoadedMsg ok (map GHC.ms_mod_name graph')
 789
 790 setContextAfterLoad session [] = do
 791   prel_mod <- getPrelude
 792   io (GHC.setContext session [] [prel_mod])
 793 setContextAfterLoad session ms = do
 794   -- load a target if one is available, otherwise load the topmost module.
 795   targets <- io (GHC.getTargets session)
 796   case [ m | Just m <- map (findTarget ms) targets ] of
 797         []    ->
 798           let graph' = flattenSCCs (GHC.topSortModuleGraph True ms Nothing) in
 799           load_this (last graph')
 800         (m:_) ->
 801           load_this m
 802  where
 803    findTarget ms t
 804     = case filter (`matches` t) ms of
 805         []    -> Nothing
 806         (m:_) -> Just m
 807
 808    summary `matches` Target (TargetModule m) _
 809         = GHC.ms_mod_name summary == m
 810    summary `matches` Target (TargetFile f _) _
 811         | Just f' <- GHC.ml_hs_file (GHC.ms_location summary)   = f == f'
 812    summary `matches` target
 813         = False
 814
 815    load_this summary | m <- GHC.ms_mod summary = do
 816         b <- io (GHC.moduleIsInterpreted session m)
 817         if b then io (GHC.setContext session [m] [])
 818              else do
 819                    prel_mod <- getPrelude
 820                    io (GHC.setContext session []  [prel_mod,m])
 821
 822
 823 modulesLoadedMsg :: SuccessFlag -> [ModuleName] -> GHCi ()
 824 modulesLoadedMsg ok mods = do
 825   dflags <- getDynFlags
 826   when (verbosity dflags > 0) $ do
 827    let mod_commas
 828         | null mods = text "none."
 829         | otherwise = hsep (
 830             punctuate comma (map ppr mods)) <> text "."
 831    case ok of
 832     Failed ->
 833        io (putStrLn (showSDoc (text "Failed, modules loaded: " <> mod_commas)))
 834     Succeeded  ->
 835        io (putStrLn (showSDoc (text "Ok, modules loaded: " <> mod_commas)))
 836
 837
 838 typeOfExpr :: String -> GHCi ()
 839 typeOfExpr str
 840   = do cms <- getSession
 841        maybe_ty <- io (GHC.exprType cms str)
 842        case maybe_ty of
 843           Nothing -> return ()
 844           Just ty -> do ty' <- cleanType ty
 845                         printForUser $ text str <> text " :: " <> ppr ty'
 846
 847 kindOfType :: String -> GHCi ()
 848 kindOfType str
 849   = do cms <- getSession
 850        maybe_ty <- io (GHC.typeKind cms str)
 851        case maybe_ty of
 852           Nothing    -> return ()
 853           Just ty    -> printForUser $ text str <> text " :: " <> ppr ty
 854
 855 quit :: String -> GHCi Bool
 856 quit _ = return True
 857
 858 shellEscape :: String -> GHCi Bool
 859 shellEscape str = io (system str >> return False)
 860
 861 -----------------------------------------------------------------------------
 862 -- create tags file for currently loaded modules.
 863
 864 createETagsFileCmd, createCTagsFileCmd :: String -> GHCi ()
 865
 866 createCTagsFileCmd ""   = ghciCreateTagsFile CTags "tags"
 867 createCTagsFileCmd file = ghciCreateTagsFile CTags file
 868
 869 createETagsFileCmd ""    = ghciCreateTagsFile ETags "TAGS"
 870 createETagsFileCmd file  = ghciCreateTagsFile ETags file
 871
 872 data TagsKind = ETags | CTags
 873
 874 ghciCreateTagsFile :: TagsKind -> FilePath -> GHCi ()
 875 ghciCreateTagsFile kind file = do
 876   session <- getSession
 877   io $ createTagsFile session kind file
 878
 879 -- ToDo:
 880 --      - remove restriction that all modules must be interpreted
 881 --        (problem: we don't know source locations for entities unless
 882 --        we compiled the module.
 883 --
 884 --      - extract createTagsFile so it can be used from the command-line
 885 --        (probably need to fix first problem before this is useful).
 886 --
 887 createTagsFile :: Session -> TagsKind -> FilePath -> IO ()
 888 createTagsFile session tagskind tagFile = do
 889   graph <- GHC.getModuleGraph session
 890   let ms = map GHC.ms_mod graph
 891       tagModule m = do
 892         is_interpreted <- GHC.moduleIsInterpreted session m
 893         -- should we just skip these?
 894         when (not is_interpreted) $
 895           throwDyn (CmdLineError ("module '"
 896                                 ++ GHC.moduleNameString (GHC.moduleName m)
 897                                 ++ "' is not interpreted"))
 898         mbModInfo <- GHC.getModuleInfo session m
 899         let unqual
 900               | Just modinfo <- mbModInfo,
 901                 Just unqual <- GHC.modInfoPrintUnqualified modinfo = unqual
 902               | otherwise = GHC.alwaysQualify
 903
 904         case mbModInfo of
 905           Just modInfo -> return $! listTags unqual modInfo
 906           _            -> return []
 907
 908   mtags <- mapM tagModule ms
 909   either_res <- collateAndWriteTags tagskind tagFile $ concat mtags
 910   case either_res of
 911     Left e  -> hPutStrLn stderr $ ioeGetErrorString e
 912     Right _ -> return ()
 913
 914 listTags :: PrintUnqualified -> GHC.ModuleInfo -> [TagInfo]
 915 listTags unqual modInfo =
 916            [ tagInfo unqual name loc
 917            | name <- GHC.modInfoExports modInfo
 918            , let loc = nameSrcLoc name
 919            , isGoodSrcLoc loc
 920            ]
 921
 922 type TagInfo = (String -- tag name
 923                ,String -- file name
 924                ,Int    -- line number
 925                ,Int    -- column number
 926                )
 927
 928 -- get tag info, for later translation into Vim or Emacs style
 929 tagInfo :: PrintUnqualified -> Name -> SrcLoc -> TagInfo
 930 tagInfo unqual name loc
 931     = ( showSDocForUser unqual $ pprOccName (nameOccName name)
 932       , showSDocForUser unqual $ ftext (srcLocFile loc)
 933       , srcLocLine loc
 934       , srcLocCol loc
 935       )
 936
 937 collateAndWriteTags :: TagsKind -> FilePath -> [TagInfo] -> IO (Either IOError ())
 938 collateAndWriteTags CTags file tagInfos = do -- ctags style, Vim et al
 939   let tags = unlines $ sortLe (<=) $ nub $ map showTag tagInfos
 940   IO.try (writeFile file tags)
 941 collateAndWriteTags ETags file tagInfos = do -- etags style, Emacs/XEmacs
 942   let byFile op (_,f1,_,_) (_,f2,_,_) = f1 `op` f2
 943       groups = groupBy (byFile (==)) $ sortLe (byFile (<=)) tagInfos
 944   tagGroups <- mapM tagFileGroup groups
 945   IO.try (writeFile file $ concat tagGroups)
 946   where
 947     tagFileGroup group@[] = throwDyn (CmdLineError "empty tag file group??")
 948     tagFileGroup group@((_,fileName,_,_):_) = do
 949       file <- readFile fileName -- need to get additional info from sources..
 950       let byLine (_,_,l1,_) (_,_,l2,_) = l1 <= l2
 951           sortedGroup = sortLe byLine group
 952           tags = unlines $ perFile sortedGroup 1 0 $ lines file
 953       return $ "\x0c\n" ++ fileName ++ "," ++ show (length tags) ++ "\n" ++ tags
 954     perFile (tagInfo@(tag,file,lNo,colNo):tags) count pos (line:lines) | lNo>count =
 955       perFile (tagInfo:tags) (count+1) (pos+length line) lines
 956     perFile (tagInfo@(tag,file,lNo,colNo):tags) count pos lines@(line:_) | lNo==count =
 957       showETag tagInfo line pos : perFile tags count pos lines
 958     perFile tags count pos lines = []
 959
 960 -- simple ctags format, for Vim et al
 961 showTag :: TagInfo -> String
 962 showTag (tag,file,lineNo,colNo)
 963     =  tag ++ "\t" ++ file ++ "\t" ++ show lineNo
 964
 965 -- etags format, for Emacs/XEmacs
 966 showETag :: TagInfo -> String -> Int -> String
 967 showETag (tag,file,lineNo,colNo) line charPos
 968     =  take colNo line ++ tag
 969     ++ "\x7f" ++ tag
 970     ++ "\x01" ++ show lineNo
 971     ++ "," ++ show charPos
 972
 973 -----------------------------------------------------------------------------
 974 -- Browsing a module's contents
 975
 976 browseCmd :: String -> GHCi ()
 977 browseCmd m =
 978   case words m of
 979     ['*':m] | looksLikeModuleName m -> browseModule m False
 980     [m]     | looksLikeModuleName m -> browseModule m True
 981     _ -> throwDyn (CmdLineError "syntax:  :browse <module>")
 982
 983 browseModule m exports_only = do
 984   s <- getSession
 985   modl <- if exports_only then lookupModule s m
 986                           else wantInterpretedModule s m
 987
 988   -- Temporarily set the context to the module we're interested in,
 989   -- just so we can get an appropriate PrintUnqualified
 990   (as,bs) <- io (GHC.getContext s)
 991   prel_mod <- getPrelude
 992   io (if exports_only then GHC.setContext s [] [prel_mod,modl]
 993                       else GHC.setContext s [modl] [])
 994   unqual <- io (GHC.getPrintUnqual s)
 995   io (GHC.setContext s as bs)
 996
 997   mb_mod_info <- io $ GHC.getModuleInfo s modl
 998   case mb_mod_info of
 999     Nothing -> throwDyn (CmdLineError ("unknown module: " ++ m))
1000     Just mod_info -> do
1001         let names
1002                | exports_only = GHC.modInfoExports mod_info
1003                | otherwise    = fromMaybe [] (GHC.modInfoTopLevelScope mod_info)
1004
1005             filtered = filterOutChildren names
1006
1007         things <- io $ mapM (GHC.lookupName s) filtered
1008
1009         dflags <- getDynFlags
1010         let exts = dopt Opt_GlasgowExts dflags
1011         io (putStrLn (showSDocForUser unqual (
1012                 vcat (map (pprTyThingInContext exts) (catMaybes things))
1013            )))
1014         -- ToDo: modInfoInstances currently throws an exception for
1015         -- package modules.  When it works, we can do this:
1016         --      $$ vcat (map GHC.pprInstance (GHC.modInfoInstances mod_info))
1017
1018 -----------------------------------------------------------------------------
1019 -- Setting the module context
1020
1021 setContext str
1022   | all sensible mods = fn mods
1023   | otherwise = throwDyn (CmdLineError "syntax:  :module [+/-] [*]M1 ... [*]Mn")
1024   where
1025     (fn, mods) = case str of
1026                         '+':stuff -> (addToContext,      words stuff)
1027                         '-':stuff -> (removeFromContext, words stuff)
1028                         stuff     -> (newContext,        words stuff)
1029
1030     sensible ('*':m) = looksLikeModuleName m
1031     sensible m       = looksLikeModuleName m
1032
1033 separate :: Session -> [String] -> [Module] -> [Module]
1034         -> GHCi ([Module],[Module])
1035 separate session []           as bs = return (as,bs)
1036 separate session (('*':str):ms) as bs = do
1037    m <- io $ GHC.findModule session (GHC.mkModuleName str) Nothing
1038    b <- io $ GHC.moduleIsInterpreted session m
1039    if b then separate session ms (m:as) bs
1040         else throwDyn (CmdLineError ("module '"
1041                         ++ GHC.moduleNameString (GHC.moduleName m)
1042                         ++ "' is not interpreted"))
1043 separate session (str:ms) as bs = do
1044   m <- io $ GHC.findModule session (GHC.mkModuleName str) Nothing
1045   separate session ms as (m:bs)
1046
1047 newContext :: [String] -> GHCi ()
1048 newContext strs = do
1049   s <- getSession
1050   (as,bs) <- separate s strs [] []
1051   prel_mod <- getPrelude
1052   let bs' = if null as && prel_mod `notElem` bs then prel_mod:bs else bs
1053   io $ GHC.setContext s as bs'
1054
1055
1056 addToContext :: [String] -> GHCi ()
1057 addToContext strs = do
1058   s <- getSession
1059   (as,bs) <- io $ GHC.getContext s
1060
1061   (new_as,new_bs) <- separate s strs [] []
1062
1063   let as_to_add = new_as \\ (as ++ bs)
1064       bs_to_add = new_bs \\ (as ++ bs)
1065
1066   io $ GHC.setContext s (as ++ as_to_add) (bs ++ bs_to_add)
1067
1068
1069 removeFromContext :: [String] -> GHCi ()
1070 removeFromContext strs = do
1071   s <- getSession
1072   (as,bs) <- io $ GHC.getContext s
1073
1074   (as_to_remove,bs_to_remove) <- separate s strs [] []
1075
1076   let as' = as \\ (as_to_remove ++ bs_to_remove)
1077       bs' = bs \\ (as_to_remove ++ bs_to_remove)
1078
1079   io $ GHC.setContext s as' bs'
1080
1081 ----------------------------------------------------------------------------
1082 -- Code for `:set'
1083
1084 -- set options in the interpreter.  Syntax is exactly the same as the
1085 -- ghc command line, except that certain options aren't available (-C,
1086 -- -E etc.)
1087 --
1088 -- This is pretty fragile: most options won't work as expected.  ToDo:
1089 -- figure out which ones & disallow them.
1090
1091 setCmd :: String -> GHCi ()
1092 setCmd ""
1093   = do st <- getGHCiState
1094        let opts = options st
1095        io $ putStrLn (showSDoc (
1096               text "options currently set: " <>
1097               if null opts
1098                    then text "none."
1099                    else hsep (map (\o -> char '+' <> text (optToStr o)) opts)
1100            ))
1101 setCmd str
1102   = case toArgs str of
1103         ("args":args) -> setArgs args
1104         ("prog":prog) -> setProg prog
1105         ("prompt":prompt) -> setPrompt (after 6)
1106         ("editor":cmd) -> setEditor (after 6)
1107         ("stop":cmd) -> setStop (after 4)
1108         wds -> setOptions wds
1109    where after n = dropWhile isSpace $ drop n $ dropWhile isSpace str
1110
1111 setArgs args = do
1112   st <- getGHCiState
1113   setGHCiState st{ args = args }
1114
1115 setProg [prog] = do
1116   st <- getGHCiState
1117   setGHCiState st{ progname = prog }
1118 setProg _ = do
1119   io (hPutStrLn stderr "syntax: :set prog <progname>")
1120
1121 setEditor cmd = do
1122   st <- getGHCiState
1123   setGHCiState st{ editor = cmd }
1124
1125 setStop cmd = do
1126   st <- getGHCiState
1127   setGHCiState st{ stop = cmd }
1128
1129 setPrompt value = do
1130   st <- getGHCiState
1131   if null value
1132       then io $ hPutStrLn stderr $ "syntax: :set prompt <prompt>, currently \"" ++ prompt st ++ "\""
1133       else setGHCiState st{ prompt = remQuotes value }
1134   where
1135      remQuotes ('\"':xs) | not (null xs) && last xs == '\"' = init xs
1136      remQuotes x = x
1137
1138 setOptions wds =
1139    do -- first, deal with the GHCi opts (+s, +t, etc.)
1140       let (plus_opts, minus_opts)  = partition isPlus wds
1141       mapM_ setOpt plus_opts
1142
1143       -- then, dynamic flags
1144       dflags <- getDynFlags
1145       let pkg_flags = packageFlags dflags
1146       (dflags',leftovers) <- io $ GHC.parseDynamicFlags dflags minus_opts
1147
1148       if (not (null leftovers))
1149                 then throwDyn (CmdLineError ("unrecognised flags: " ++
1150                                                 unwords leftovers))
1151                 else return ()
1152
1153       new_pkgs <- setDynFlags dflags'
1154
1155       -- if the package flags changed, we should reset the context
1156       -- and link the new packages.
1157       dflags <- getDynFlags
1158       when (packageFlags dflags /= pkg_flags) $ do
1159         io $ hPutStrLn stderr "package flags have changed, ressetting and loading new packages..."
1160         session <- getSession
1161         io (GHC.setTargets session [])
1162         io (GHC.load session LoadAllTargets)
1163         io (linkPackages dflags new_pkgs)
1164         setContextAfterLoad session []
1165       return ()
1166
1167
1168 unsetOptions :: String -> GHCi ()
1169 unsetOptions str
1170   = do -- first, deal with the GHCi opts (+s, +t, etc.)
1171        let opts = words str
1172            (minus_opts, rest1) = partition isMinus opts
1173            (plus_opts, rest2)  = partition isPlus rest1
1174
1175        if (not (null rest2))
1176           then io (putStrLn ("unknown option: '" ++ head rest2 ++ "'"))
1177           else do
1178
1179        mapM_ unsetOpt plus_opts
1180
1181        -- can't do GHC flags for now
1182        if (not (null minus_opts))
1183           then throwDyn (CmdLineError "can't unset GHC command-line flags")
1184           else return ()
1185
1186 isMinus ('-':s) = True
1187 isMinus _ = False
1188
1189 isPlus ('+':s) = True
1190 isPlus _ = False
1191
1192 setOpt ('+':str)
1193   = case strToGHCiOpt str of
1194         Nothing -> io (putStrLn ("unknown option: '" ++ str ++ "'"))
1195         Just o  -> setOption o
1196
1197 unsetOpt ('+':str)
1198   = case strToGHCiOpt str of
1199         Nothing -> io (putStrLn ("unknown option: '" ++ str ++ "'"))
1200         Just o  -> unsetOption o
1201
1202 strToGHCiOpt :: String -> (Maybe GHCiOption)
1203 strToGHCiOpt "s" = Just ShowTiming
1204 strToGHCiOpt "t" = Just ShowType
1205 strToGHCiOpt "r" = Just RevertCAFs
1206 strToGHCiOpt _   = Nothing
1207
1208 optToStr :: GHCiOption -> String
1209 optToStr ShowTiming = "s"
1210 optToStr ShowType   = "t"
1211 optToStr RevertCAFs = "r"
1212
1213 -- ---------------------------------------------------------------------------
1214 -- code for `:show'
1215
1216 showCmd str =
1217   case words str of
1218         ["modules" ] -> showModules
1219         ["bindings"] -> showBindings
1220         ["linker"]   -> io showLinkerState
1221         ["breaks"] -> showBkptTable
1222         ["context"] -> showContext
1223         _ -> throwDyn (CmdLineError "syntax:  :show [modules|bindings|breaks]")
1224
1225 showModules = do
1226   session <- getSession
1227   let show_one ms = do m <- io (GHC.showModule session ms)
1228                        io (putStrLn m)
1229   graph <- io (GHC.getModuleGraph session)
1230   mapM_ show_one graph
1231
1232 showBindings = do
1233   s <- getSession
1234   unqual <- io (GHC.getPrintUnqual s)
1235   bindings <- io (GHC.getBindings s)
1236   mapM_ showTyThing bindings
1237   return ()
1238
1239 showTyThing (AnId id) = do
1240   ty' <- cleanType (GHC.idType id)
1241   printForUser $ ppr id <> text " :: " <> ppr ty'
1242 showTyThing _  = return ()
1243
1244 -- if -fglasgow-exts is on we show the foralls, otherwise we don't.
1245 cleanType :: Type -> GHCi Type
1246 cleanType ty = do
1247   dflags <- getDynFlags
1248   if dopt Opt_GlasgowExts dflags
1249         then return ty
1250         else return $! GHC.dropForAlls ty
1251
1252 showBkptTable :: GHCi ()
1253 showBkptTable = do
1254    activeBreaks <- getActiveBreakPoints
1255    printForUser $ ppr activeBreaks
1256
1257 showContext :: GHCi ()
1258 showContext = do
1259    st <- getGHCiState
1260    printForUser $ vcat (map pp_resume (resume st))
1261   where
1262    pp_resume (span, _, _) = ptext SLIT("Stopped at") <+> ppr span
1263
1264 -- -----------------------------------------------------------------------------
1265 -- Completion
1266
1267 completeNone :: String -> IO [String]
1268 completeNone w = return []
1269
1270 #ifdef USE_READLINE
1271 completeWord :: String -> Int -> Int -> IO (Maybe (String, [String]))
1272 completeWord w start end = do
1273   line <- Readline.getLineBuffer
1274   case w of
1275      ':':_ | all isSpace (take (start-1) line) -> wrapCompleter completeCmd w
1276      _other
1277         | Just c <- is_cmd line -> do
1278            maybe_cmd <- lookupCommand c
1279            let (n,w') = selectWord (words' 0 line)
1280            case maybe_cmd of
1281              Nothing -> return Nothing
1282              Just (_,_,False,complete) -> wrapCompleter complete w
1283              Just (_,_,True,complete) -> let complete' w = do rets <- complete w
1284                                                               return (map (drop n) rets)
1285                                          in wrapCompleter complete' w'
1286         | otherwise     -> do
1287                 --printf "complete %s, start = %d, end = %d\n" w start end
1288                 wrapCompleter completeIdentifier w
1289     where words' _ [] = []
1290           words' n str = let (w,r) = break isSpace str
1291                              (s,r') = span isSpace r
1292                          in (n,w):words' (n+length w+length s) r'
1293           -- In a Haskell expression we want to parse 'a-b' as three words
1294           -- where a compiler flag (ie. -fno-monomorphism-restriction) should
1295           -- only be a single word.
1296           selectWord [] = (0,w)
1297           selectWord ((offset,x):xs)
1298               | offset+length x >= start = (start-offset,take (end-offset) x)
1299               | otherwise = selectWord xs
1300
1301 is_cmd line
1302  | ((':':w) : _) <- words (dropWhile isSpace line) = Just w
1303  | otherwise = Nothing
1304
1305 completeCmd w = do
1306   cmds <- readIORef commands
1307   return (filter (w `isPrefixOf`) (map (':':) (map cmdName cmds)))
1308
1309 completeMacro w = do
1310   cmds <- readIORef commands
1311   let cmds' = [ cmd | cmd <- map cmdName cmds, cmd `elem` map cmdName builtin_commands ]
1312   return (filter (w `isPrefixOf`) cmds')
1313
1314 completeIdentifier w = do
1315   s <- restoreSession
1316   rdrs <- GHC.getRdrNamesInScope s
1317   return (filter (w `isPrefixOf`) (map (showSDoc.ppr) rdrs))
1318
1319 completeModule w = do
1320   s <- restoreSession
1321   dflags <- GHC.getSessionDynFlags s
1322   let pkg_mods = allExposedModules dflags
1323   return (filter (w `isPrefixOf`) (map (showSDoc.ppr) pkg_mods))
1324
1325 completeHomeModule w = do
1326   s <- restoreSession
1327   g <- GHC.getModuleGraph s
1328   let home_mods = map GHC.ms_mod_name g
1329   return (filter (w `isPrefixOf`) (map (showSDoc.ppr) home_mods))
1330
1331 completeSetOptions w = do
1332   return (filter (w `isPrefixOf`) options)
1333     where options = "args":"prog":allFlags
1334
1335 completeFilename = Readline.filenameCompletionFunction
1336
1337 completeHomeModuleOrFile = unionComplete completeHomeModule completeFilename
1338
1339 unionComplete :: (String -> IO [String]) -> (String -> IO [String]) -> String -> IO [String]
1340 unionComplete f1 f2 w = do
1341   s1 <- f1 w
1342   s2 <- f2 w
1343   return (s1 ++ s2)
1344
1345 wrapCompleter :: (String -> IO [String]) -> String -> IO (Maybe (String,[String]))
1346 wrapCompleter fun w =  do
1347   strs <- fun w
1348   case strs of
1349     []  -> return Nothing
1350     [x] -> return (Just (x,[]))
1351     xs  -> case getCommonPrefix xs of
1352                 ""   -> return (Just ("",xs))
1353                 pref -> return (Just (pref,xs))
1354
1355 getCommonPrefix :: [String] -> String
1356 getCommonPrefix [] = ""
1357 getCommonPrefix (s:ss) = foldl common s ss
1358   where common s "" = ""
1359         common "" s = ""
1360         common (c:cs) (d:ds)
1361            | c == d = c : common cs ds
1362            | otherwise = ""
1363
1364 allExposedModules :: DynFlags -> [ModuleName]
1365 allExposedModules dflags
1366  = map GHC.mkModuleName (concat (map exposedModules (filter exposed (eltsUFM pkg_db))))
1367  where
1368   pkg_db = pkgIdMap (pkgState dflags)
1369 #else
1370 completeCmd        = completeNone
1371 completeMacro      = completeNone
1372 completeIdentifier = completeNone
1373 completeModule     = completeNone
1374 completeHomeModule = completeNone
1375 completeSetOptions = completeNone
1376 completeFilename   = completeNone
1377 completeHomeModuleOrFile=completeNone
1378 completeBkpt       = completeNone
1379 #endif
1380
1381 -- ---------------------------------------------------------------------------
1382 -- User code exception handling
1383
1384 -- This is the exception handler for exceptions generated by the
1385 -- user's code and exceptions coming from children sessions;
1386 -- it normally just prints out the exception.  The
1387 -- handler must be recursive, in case showing the exception causes
1388 -- more exceptions to be raised.
1389 --
1390 -- Bugfix: if the user closed stdout or stderr, the flushing will fail,
1391 -- raising another exception.  We therefore don't put the recursive
1392 -- handler arond the flushing operation, so if stderr is closed
1393 -- GHCi will just die gracefully rather than going into an infinite loop.
1394 handler :: Exception -> GHCi Bool
1395
1396 handler exception = do
1397   flushInterpBuffers
1398   io installSignalHandlers
1399   ghciHandle handler (showException exception >> return False)
1400
1401 showException (DynException dyn) =
1402   case fromDynamic dyn of
1403     Nothing               -> io (putStrLn ("*** Exception: (unknown)"))
1404     Just Interrupted      -> io (putStrLn "Interrupted.")
1405     Just (CmdLineError s) -> io (putStrLn s)     -- omit the location for CmdLineError
1406     Just ph@PhaseFailed{} -> io (putStrLn (showGhcException ph "")) -- ditto
1407     Just other_ghc_ex     -> io (print other_ghc_ex)
1408
1409 showException other_exception
1410   = io (putStrLn ("*** Exception: " ++ show other_exception))
1411
1412 -----------------------------------------------------------------------------
1413 -- recursive exception handlers
1414
1415 -- Don't forget to unblock async exceptions in the handler, or if we're
1416 -- in an exception loop (eg. let a = error a in a) the ^C exception
1417 -- may never be delivered.  Thanks to Marcin for pointing out the bug.
1418
1419 ghciHandle :: (Exception -> GHCi a) -> GHCi a -> GHCi a
1420 ghciHandle h (GHCi m) = GHCi $ \s ->
1421    Exception.catch (m s)
1422         (\e -> unGHCi (ghciUnblock (h e)) s)
1423
1424 ghciUnblock :: GHCi a -> GHCi a
1425 ghciUnblock (GHCi a) = GHCi $ \s -> Exception.unblock (a s)
1426
1427
1428 -- ----------------------------------------------------------------------------
1429 -- Utils
1430
1431 expandPath :: String -> GHCi String
1432 expandPath path =
1433   case dropWhile isSpace path of
1434    ('~':d) -> do
1435         tilde <- io (getEnv "HOME")     -- will fail if HOME not defined
1436         return (tilde ++ '/':d)
1437    other ->
1438         return other
1439
1440 -- ----------------------------------------------------------------------------
1441 -- Windows console setup
1442
1443 setUpConsole :: IO ()
1444 setUpConsole = do
1445 #ifdef mingw32_HOST_OS
1446         -- On Windows we need to set a known code page, otherwise the characters
1447         -- we read from the console will be be in some strange encoding, and
1448         -- similarly for characters we write to the console.
1449         --
1450         -- At the moment, GHCi pretends all input is Latin-1.  In the
1451         -- future we should support UTF-8, but for now we set the code pages
1452         -- to Latin-1.
1453         --
1454         -- It seems you have to set the font in the console window to
1455         -- a Unicode font in order for output to work properly,
1456         -- otherwise non-ASCII characters are mapped wrongly.  sigh.
1457         -- (see MSDN for SetConsoleOutputCP()).
1458         --
1459         setConsoleCP 28591       -- ISO Latin-1
1460         setConsoleOutputCP 28591 -- ISO Latin-1
1461 #endif
1462         return ()
1463
1464 -- -----------------------------------------------------------------------------
1465 -- commands for debugger
1466
1467 foreign import ccall "rts_setStepFlag" setStepFlag :: IO ()
1468
1469 stepCmd :: String -> GHCi Bool
1470 stepCmd [] = doContinue setStepFlag
1471 stepCmd expression = do
1472    io $ setStepFlag
1473    runCommand expression
1474
1475 continueCmd :: String -> GHCi Bool
1476 continueCmd [] = doContinue $ return ()
1477 continueCmd other = do
1478    io $ putStrLn "The continue command accepts no arguments."
1479    return False
1480
1481 doContinue :: IO () -> GHCi Bool
1482 doContinue actionBeforeCont = do
1483    resumeAction <- popResume
1484    case resumeAction of
1485       Nothing -> do
1486          io $ putStrLn "There is no computation running."
1487          return False
1488       Just (_,_,handle) -> do
1489          io $ actionBeforeCont
1490          session <- getSession
1491          runResult <- io $ GHC.resume session handle
1492          names <- switchOnRunResult runResult
1493          finishEvalExpr names
1494          return False
1495
1496 deleteCmd :: String -> GHCi ()
1497 deleteCmd argLine = do
1498    deleteSwitch $ words argLine
1499    where
1500    deleteSwitch :: [String] -> GHCi ()
1501    deleteSwitch [] =
1502       io $ putStrLn "The delete command requires at least one argument."
1503    -- delete all break points
1504    deleteSwitch ("*":_rest) = discardActiveBreakPoints
1505    deleteSwitch idents = do
1506       mapM_ deleteOneBreak idents
1507       where
1508       deleteOneBreak :: String -> GHCi ()
1509       deleteOneBreak str
1510          | all isDigit str = deleteBreak (read str)
1511          | otherwise = return ()
1512
1513 -- handle the "break" command
1514 breakCmd :: String -> GHCi ()
1515 breakCmd argLine = do
1516    session <- getSession
1517    breakSwitch session $ words argLine
1518
1519 breakSwitch :: Session -> [String] -> GHCi ()
1520 breakSwitch _session [] = do
1521    io $ putStrLn "The break command requires at least one argument."
1522 breakSwitch session args@(arg1:rest)
1523    | looksLikeModuleName arg1 = do
1524         mod <- wantInterpretedModule session arg1
1525         breakByModule session mod rest
1526    | all isDigit arg1 = do
1527         (toplevel, _) <- io $ GHC.getContext session
1528         case toplevel of
1529            (mod : _) -> breakByModuleLine mod (read arg1) rest
1530            [] -> do
1531               io $ putStrLn "Cannot find default module for breakpoint."
1532               io $ putStrLn "Perhaps no modules are loaded for debugging?"
1533    | otherwise = do -- assume it's a name
1534         names <- io $ GHC.parseName session arg1
1535         case names of
1536           []    -> return ()
1537           (n:_) -> do
1538             let loc  = nameSrcLoc n
1539                 modl = nameModule n
1540             is_interpreted <- io (GHC.moduleIsInterpreted session modl)
1541             if not is_interpreted
1542                then noCanDo $ text "module " <> ppr modl <>
1543                               text " is not interpreted"
1544                else do
1545             if isGoodSrcLoc loc
1546                then findBreakAndSet (nameModule n) $
1547                          findBreakByCoord (srcLocLine loc, srcLocCol loc)
1548                else noCanDo $ text "can't find its location: " <>
1549                               ppr loc
1550            where
1551              noCanDo why = printForUser $
1552                 text "cannot set breakpoint on " <> ppr n <> text ": " <> why
1553
1554
1555 wantInterpretedModule :: Session -> String -> GHCi Module
1556 wantInterpretedModule session str = do
1557    modl <- io $ GHC.findModule session (GHC.mkModuleName str) Nothing
1558    is_interpreted <- io (GHC.moduleIsInterpreted session modl)
1559    when (not is_interpreted) $
1560        throwDyn (CmdLineError ("module '" ++ str ++ "' is not interpreted"))
1561    return modl
1562
1563 breakByModule :: Session -> Module -> [String] -> GHCi ()
1564 breakByModule session mod args@(arg1:rest)
1565    | all isDigit arg1 = do  -- looks like a line number
1566         breakByModuleLine mod (read arg1) rest
1567    | otherwise = io $ putStrLn "Invalid arguments to :break"
1568
1569 breakByModuleLine :: Module -> Int -> [String] -> GHCi ()
1570 breakByModuleLine mod line args
1571    | [] <- args = findBreakAndSet mod $ findBreakByLine line
1572    | [col] <- args, all isDigit col =
1573         findBreakAndSet mod $ findBreakByCoord (line, read col)
1574    | otherwise = io $ putStrLn "Invalid arguments to :break"
1575
1576 findBreakAndSet :: Module -> (TickArray -> Maybe (Int, SrcSpan)) -> GHCi ()
1577 findBreakAndSet mod lookupTickTree = do
1578    tickArray <- getTickArray mod
1579    (breakArray, _) <- getModBreak mod
1580    case lookupTickTree tickArray of
1581       Nothing  -> io $ putStrLn $ "No breakpoints found at that location."
1582       Just (tick, span) -> do
1583          success <- io $ setBreakFlag True breakArray tick
1584          session <- getSession
1585          if success
1586             then do
1587                (alreadySet, nm) <-
1588                      recordBreak $ BreakLocation
1589                              { breakModule = mod
1590                              , breakLoc = span
1591                              , breakTick = tick
1592                              }
1593                printForUser $
1594                   text "Breakpoint " <> ppr nm <>
1595                   if alreadySet
1596                      then text " was already set at " <> ppr span
1597                      else text " activated at " <> ppr span
1598             else do
1599             printForUser $ text "Breakpoint could not be activated at"
1600                                  <+> ppr span
1601
1602 -- When a line number is specified, the current policy for choosing
1603 -- the best breakpoint is this:
1604 --    - the leftmost complete subexpression on the specified line, or
1605 --    - the leftmost subexpression starting on the specified line, or
1606 --    - the rightmost subexpression enclosing the specified line
1607 --
1608 findBreakByLine :: Int -> TickArray -> Maybe (BreakIndex,SrcSpan)
1609 findBreakByLine line arr
1610   | not (inRange (bounds arr) line) = Nothing
1611   | otherwise =
1612     listToMaybe (sortBy leftmost_largest  complete)   `mplus`
1613     listToMaybe (sortBy leftmost_smallest incomplete) `mplus`
1614     listToMaybe (sortBy rightmost ticks)
1615   where
1616         ticks = arr ! line
1617
1618         starts_here = [ tick | tick@(nm,span) <- ticks,
1619                                srcSpanStartLine span == line ]
1620
1621         (complete,incomplete) = partition ends_here starts_here
1622             where ends_here (nm,span) = srcSpanEndLine span == line
1623
1624 findBreakByCoord :: (Int,Int) -> TickArray -> Maybe (BreakIndex,SrcSpan)
1625 findBreakByCoord (line, col) arr
1626   | not (inRange (bounds arr) line) = Nothing
1627   | otherwise =
1628     listToMaybe (sortBy rightmost contains)
1629   where
1630         ticks = arr ! line
1631
1632         -- the ticks that span this coordinate
1633         contains = [ tick | tick@(nm,span) <- ticks, span `spans` (line,col) ]
1634
1635 leftmost_smallest  (_,a) (_,b) = a `compare` b
1636 leftmost_largest   (_,a) (_,b) = (srcSpanStart a `compare` srcSpanStart b)
1637                                 `thenCmp`
1638                                  (srcSpanEnd b `compare` srcSpanEnd a)
1639 rightmost (_,a) (_,b) = b `compare` a
1640
1641 spans :: SrcSpan -> (Int,Int) -> Bool
1642 spans span (l,c) = srcSpanStart span <= loc && loc <= srcSpanEnd span
1643    where loc = mkSrcLoc (srcSpanFile span) l c
1644
1645 start_bold = BS.pack "\ESC[1m"
1646 end_bold   = BS.pack "\ESC[0m"
1647
1648 listCmd :: String -> GHCi ()
1649 listCmd str = do
1650    st <- getGHCiState
1651    case resume st of
1652       []  -> printForUser $ text "not stopped at a breakpoint; nothing to list"
1653       (span,_,_):_ -> io $ listAround span True
1654
1655 -- | list a section of a source file around a particular SrcSpan.
1656 -- If the highlight flag is True, also highlight the span using
1657 -- start_bold/end_bold.
1658 listAround span do_highlight = do
1659       contents <- BS.readFile (unpackFS file)
1660       let
1661           lines = BS.split '\n' contents
1662           these_lines = take (line2 - line1 + 1 + pad_before + pad_after) $
1663                         drop (line1 - 1 - pad_before) $ lines
1664           fst_line = max 1 (line1 - pad_before)
1665           line_nos = [ fst_line .. ]
1666
1667           highlighted | do_highlight = zipWith highlight line_nos these_lines
1668                       | otherwise   = these_lines
1669
1670           bs_line_nos = [ BS.pack (show l ++ "  ") | l <- line_nos ]
1671           prefixed = zipWith BS.append bs_line_nos highlighted
1672       --
1673       BS.putStrLn (BS.join (BS.pack "\n") prefixed)
1674   where
1675         file  = srcSpanFile span
1676         line1 = srcSpanStartLine span
1677         col1  = srcSpanStartCol span
1678         line2 = srcSpanEndLine span
1679         col2  = srcSpanEndCol span
1680
1681         pad_before | line1 == 1 = 0
1682                    | otherwise  = 1
1683         pad_after = 1
1684
1685         highlight no line
1686           | no == line1 && no == line2
1687           = let (a,r) = BS.splitAt col1 line
1688                 (b,c) = BS.splitAt (col2-col1) r
1689             in
1690             BS.concat [a,start_bold,b,end_bold,c]
1691           | no == line1
1692           = let (a,b) = BS.splitAt col1 line in
1693             BS.concat [a, start_bold, b]
1694           | no == line2
1695           = let (a,b) = BS.splitAt col2 line in
1696             BS.concat [a, end_bold, b]
1697           | otherwise   = line
1698
1699 -- --------------------------------------------------------------------------
1700 -- Tick arrays
1701
1702 getTickArray :: Module -> GHCi TickArray
1703 getTickArray modl = do
1704    st <- getGHCiState
1705    let arrmap = tickarrays st
1706    case lookupModuleEnv arrmap modl of
1707       Just arr -> return arr
1708       Nothing  -> do
1709         (breakArray, ticks) <- getModBreak modl
1710         let arr = mkTickArray (assocs ticks)
1711         setGHCiState st{tickarrays = extendModuleEnv arrmap modl arr}
1712         return arr
1713
1714 discardTickArrays :: GHCi ()
1715 discardTickArrays = do
1716    st <- getGHCiState
1717    setGHCiState st{tickarrays = emptyModuleEnv}
1718
1719 mkTickArray :: [(BreakIndex,SrcSpan)] -> TickArray
1720 mkTickArray ticks
1721   = accumArray (flip (:)) [] (1, max_line)
1722         [ (line, (nm,span)) | (nm,span) <- ticks,
1723                               line <- srcSpanLines span ]
1724     where
1725         max_line = maximum (map srcSpanEndLine (map snd ticks))
1726         srcSpanLines span = [ srcSpanStartLine span .. srcSpanEndLine span ]
1727
1728 getModBreak :: Module -> GHCi (GHC.BreakArray, Array Int SrcSpan)
1729 getModBreak mod = do
1730    session <- getSession
1731    Just mod_info <- io $ GHC.getModuleInfo session mod
1732    let modBreaks  = GHC.modInfoModBreaks mod_info
1733    let array      = GHC.modBreaks_flags modBreaks
1734    let ticks      = GHC.modBreaks_locs  modBreaks
1735    return (array, ticks)
1736
1737 lookupModule :: Session -> String -> GHCi Module
1738 lookupModule session modName
1739    = io (GHC.findModule session (GHC.mkModuleName modName) Nothing)
1740
1741 setBreakFlag :: Bool -> GHC.BreakArray -> Int -> IO Bool
1742 setBreakFlag toggle array index
1743    | toggle    = GHC.setBreakOn array index
1744    | otherwise = GHC.setBreakOff array index
1745
1746
1747 {- these should probably go to the GHC API at some point -}
1748 enableBreakPoint  :: Session -> Module -> Int -> IO ()
1749 enableBreakPoint session mod index = return ()
1750
1751 disableBreakPoint :: Session -> Module -> Int -> IO ()
1752 disableBreakPoint session mod index = return ()
1753
1754 activeBreakPoints :: Session -> IO [(Module,Int)]
1755 activeBreakPoints session = return []
1756
1757 enableSingleStep  :: Session -> IO ()
1758 enableSingleStep session = return ()
1759
1760 disableSingleStep :: Session -> IO ()
1761 disableSingleStep session = return ()