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 (resume st) (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 resumes 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
 455           | (span,_,_):rest <- resumes
 456           = (if not (null rest) then text "... " else empty)
 457             <> brackets (ppr span) <+> modules_prompt
 458           | otherwise
 459           = modules_prompt
 460
 461         modules_prompt =
 462              hsep (map (\m -> char '*' <> ppr (GHC.moduleName m)) toplevs) <+>
 463              hsep (map (ppr . GHC.moduleName) exports)
 464
 465
 466
 467 #ifdef USE_READLINE
 468 readlineLoop :: GHCi ()
 469 readlineLoop = do
 470    session <- getSession
 471    (mod,imports) <- io (GHC.getContext session)
 472    io yield
 473    saveSession -- for use by completion
 474    st <- getGHCiState
 475    l <- io (readline (mkPrompt mod imports (resume st) (prompt st))
 476                 `finally` setNonBlockingFD 0)
 477                 -- readline sometimes puts stdin into blocking mode,
 478                 -- so we need to put it back for the IO library
 479    splatSavedSession
 480    case l of
 481         Nothing -> return ()
 482         Just l  ->
 483           case removeSpaces l of
 484             "" -> readlineLoop
 485             l  -> do
 486                   io (addHistory l)
 487                   quit <- runCommand l
 488                   if quit then return () else readlineLoop
 489 #endif
 490
 491 runCommand :: String -> GHCi Bool
 492 runCommand c = ghciHandle handler (doCommand c)
 493   where
 494     doCommand (':' : command) = specialCommand command
 495     doCommand stmt
 496        = do timeIt (do nms <- runStmt stmt; finishEvalExpr nms)
 497             return False
 498
 499 -- This version is for the GHC command-line option -e.  The only difference
 500 -- from runCommand is that it catches the ExitException exception and
 501 -- exits, rather than printing out the exception.
 502 runCommandEval c = ghciHandle handleEval (doCommand c)
 503   where
 504     handleEval (ExitException code) = io (exitWith code)
 505     handleEval e                    = do handler e
 506                                          io (exitWith (ExitFailure 1))
 507
 508     doCommand (':' : command) = specialCommand command
 509     doCommand stmt
 510        = do nms <- runStmt stmt
 511             case nms of
 512                 Nothing -> io (exitWith (ExitFailure 1))
 513                   -- failure to run the command causes exit(1) for ghc -e.
 514                 _       -> do finishEvalExpr nms
 515                               return True
 516
 517 runStmt :: String -> GHCi (Maybe (Bool,[Name]))
 518 runStmt stmt
 519  | null (filter (not.isSpace) stmt) = return (Just (False,[]))
 520  | otherwise
 521  = do st <- getGHCiState
 522       session <- getSession
 523       result <- io $ withProgName (progname st) $ withArgs (args st) $
 524                      GHC.runStmt session stmt
 525       switchOnRunResult result
 526
 527 switchOnRunResult :: GHC.RunResult -> GHCi (Maybe (Bool,[Name]))
 528 switchOnRunResult GHC.RunFailed = return Nothing
 529 switchOnRunResult (GHC.RunException e) = throw e
 530 switchOnRunResult (GHC.RunOk names) = return $ Just (False,names)
 531 switchOnRunResult (GHC.RunBreak threadId names info resume) = do
 532    session <- getSession
 533    Just mod_info <- io $ GHC.getModuleInfo session (GHC.breakInfo_module info)
 534    let modBreaks  = GHC.modInfoModBreaks mod_info
 535    let ticks      = GHC.modBreaks_locs modBreaks
 536
 537    -- display information about the breakpoint
 538    let location = ticks ! GHC.breakInfo_number info
 539    printForUser $ ptext SLIT("Stopped at") <+> ppr location
 540
 541    pushResume location threadId resume
 542
 543    -- run the command set with ":set stop <cmd>"
 544    st <- getGHCiState
 545    runCommand (stop st)
 546
 547    return (Just (True,names))
 548
 549 -- possibly print the type and revert CAFs after evaluating an expression
 550 finishEvalExpr mb_names
 551  = do show_types <- isOptionSet ShowType
 552       session <- getSession
 553       case mb_names of
 554         Nothing    -> return ()
 555         Just (is_break,names) ->
 556                 when (is_break || show_types) $
 557                       mapM_ (showTypeOfName session) names
 558
 559       flushInterpBuffers
 560       io installSignalHandlers
 561       b <- isOptionSet RevertCAFs
 562       io (when b revertCAFs)
 563
 564 showTypeOfName :: Session -> Name -> GHCi ()
 565 showTypeOfName session n
 566    = do maybe_tything <- io (GHC.lookupName session n)
 567         case maybe_tything of
 568           Nothing    -> return ()
 569           Just thing -> showTyThing thing
 570
 571 specialCommand :: String -> GHCi Bool
 572 specialCommand ('!':str) = shellEscape (dropWhile isSpace str)
 573 specialCommand str = do
 574   let (cmd,rest) = break isSpace str
 575   maybe_cmd <- io (lookupCommand cmd)
 576   case maybe_cmd of
 577     Nothing -> io (hPutStr stdout ("unknown command ':" ++ cmd ++ "'\n"
 578                                     ++ shortHelpText) >> return False)
 579     Just (_,f,_,_) -> f (dropWhile isSpace rest)
 580
 581 lookupCommand :: String -> IO (Maybe Command)
 582 lookupCommand str = do
 583   cmds <- readIORef commands
 584   -- look for exact match first, then the first prefix match
 585   case [ c | c <- cmds, str == cmdName c ] of
 586      c:_ -> return (Just c)
 587      [] -> case [ c | c@(s,_,_,_) <- cmds, prefixMatch str s ] of
 588                 [] -> return Nothing
 589                 c:_ -> return (Just c)
 590
 591 -----------------------------------------------------------------------------
 592 -- Commands
 593
 594 help :: String -> GHCi ()
 595 help _ = io (putStr helpText)
 596
 597 info :: String -> GHCi ()
 598 info "" = throwDyn (CmdLineError "syntax: ':i <thing-you-want-info-about>'")
 599 info s  = do { let names = words s
 600              ; session <- getSession
 601              ; dflags <- getDynFlags
 602              ; let exts = dopt Opt_GlasgowExts dflags
 603              ; mapM_ (infoThing exts session) names }
 604   where
 605     infoThing exts session str = io $ do
 606         names <- GHC.parseName session str
 607         let filtered = filterOutChildren names
 608         mb_stuffs <- mapM (GHC.getInfo session) filtered
 609         unqual <- GHC.getPrintUnqual session
 610         putStrLn (showSDocForUser unqual $
 611                    vcat (intersperse (text "") $
 612                    [ pprInfo exts stuff | Just stuff <-  mb_stuffs ]))
 613
 614   -- Filter out names whose parent is also there Good
 615   -- example is '[]', which is both a type and data
 616   -- constructor in the same type
 617 filterOutChildren :: [Name] -> [Name]
 618 filterOutChildren names = filter (not . parent_is_there) names
 619  where parent_is_there n
 620 --       | Just p <- GHC.nameParent_maybe n = p `elem` names
 621 -- ToDo!!
 622          | otherwise                       = False
 623
 624 pprInfo exts (thing, fixity, insts)
 625   =  pprTyThingInContextLoc exts thing
 626   $$ show_fixity fixity
 627   $$ vcat (map GHC.pprInstance insts)
 628   where
 629     show_fixity fix
 630         | fix == GHC.defaultFixity = empty
 631         | otherwise                = ppr fix <+> ppr (GHC.getName thing)
 632
 633 -----------------------------------------------------------------------------
 634 -- Commands
 635
 636 runMain :: String -> GHCi ()
 637 runMain args = do
 638   let ss = concat $ intersperse "," (map (\ s -> ('"':s)++"\"") (toArgs args))
 639   runCommand $ '[': ss ++ "] `System.Environment.withArgs` main"
 640   return ()
 641
 642 addModule :: [FilePath] -> GHCi ()
 643 addModule files = do
 644   io (revertCAFs)                       -- always revert CAFs on load/add.
 645   files <- mapM expandPath files
 646   targets <- mapM (\m -> io (GHC.guessTarget m Nothing)) files
 647   session <- getSession
 648   io (mapM_ (GHC.addTarget session) targets)
 649   ok <- io (GHC.load session LoadAllTargets)
 650   afterLoad ok session
 651
 652 changeDirectory :: String -> GHCi ()
 653 changeDirectory dir = do
 654   session <- getSession
 655   graph <- io (GHC.getModuleGraph session)
 656   when (not (null graph)) $
 657         io $ putStr "Warning: changing directory causes all loaded modules to be unloaded,\nbecause the search path has changed.\n"
 658   io (GHC.setTargets session [])
 659   io (GHC.load session LoadAllTargets)
 660   setContextAfterLoad session []
 661   io (GHC.workingDirectoryChanged session)
 662   dir <- expandPath dir
 663   io (setCurrentDirectory dir)
 664
 665 editFile :: String -> GHCi ()
 666 editFile str
 667   | null str  = do
 668         -- find the name of the "topmost" file loaded
 669      session <- getSession
 670      graph0 <- io (GHC.getModuleGraph session)
 671      graph1 <- filterM (io . GHC.isLoaded session . GHC.ms_mod_name) graph0
 672      let graph2 = flattenSCCs (GHC.topSortModuleGraph True graph1 Nothing)
 673      case GHC.ml_hs_file (GHC.ms_location (last graph2)) of
 674         Just file -> do_edit file
 675         Nothing   -> throwDyn (CmdLineError "unknown file name")
 676   | otherwise = do_edit str
 677   where
 678         do_edit file = do
 679            st <- getGHCiState
 680            let cmd = editor st
 681            when (null cmd) $
 682                 throwDyn (CmdLineError "editor not set, use :set editor")
 683            io $ system (cmd ++ ' ':file)
 684            return ()
 685
 686 defineMacro :: String -> GHCi ()
 687 defineMacro s = do
 688   let (macro_name, definition) = break isSpace s
 689   cmds <- io (readIORef commands)
 690   if (null macro_name)
 691         then throwDyn (CmdLineError "invalid macro name")
 692         else do
 693   if (macro_name `elem` map cmdName cmds)
 694         then throwDyn (CmdLineError
 695                 ("command '" ++ macro_name ++ "' is already defined"))
 696         else do
 697
 698   -- give the expression a type signature, so we can be sure we're getting
 699   -- something of the right type.
 700   let new_expr = '(' : definition ++ ") :: String -> IO String"
 701
 702   -- compile the expression
 703   cms <- getSession
 704   maybe_hv <- io (GHC.compileExpr cms new_expr)
 705   case maybe_hv of
 706      Nothing -> return ()
 707      Just hv -> io (writeIORef commands --
 708                     (cmds ++ [(macro_name, runMacro hv, False, completeNone)]))
 709
 710 runMacro :: GHC.HValue{-String -> IO String-} -> String -> GHCi Bool
 711 runMacro fun s = do
 712   str <- io ((unsafeCoerce# fun :: String -> IO String) s)
 713   stringLoop (lines str)
 714
 715 undefineMacro :: String -> GHCi ()
 716 undefineMacro macro_name = do
 717   cmds <- io (readIORef commands)
 718   if (macro_name `elem` map cmdName builtin_commands)
 719         then throwDyn (CmdLineError
 720                 ("command '" ++ macro_name ++ "' cannot be undefined"))
 721         else do
 722   if (macro_name `notElem` map cmdName cmds)
 723         then throwDyn (CmdLineError
 724                 ("command '" ++ macro_name ++ "' not defined"))
 725         else do
 726   io (writeIORef commands (filter ((/= macro_name) . cmdName) cmds))
 727
 728
 729 loadModule :: [(FilePath, Maybe Phase)] -> GHCi SuccessFlag
 730 loadModule fs = timeIt (loadModule' fs)
 731
 732 loadModule_ :: [FilePath] -> GHCi ()
 733 loadModule_ fs = do loadModule (zip fs (repeat Nothing)); return ()
 734
 735 loadModule' :: [(FilePath, Maybe Phase)] -> GHCi SuccessFlag
 736 loadModule' files = do
 737   session <- getSession
 738
 739   -- unload first
 740   io (GHC.setTargets session [])
 741   io (GHC.load session LoadAllTargets)
 742
 743   -- expand tildes
 744   let (filenames, phases) = unzip files
 745   exp_filenames <- mapM expandPath filenames
 746   let files' = zip exp_filenames phases
 747   targets <- io (mapM (uncurry GHC.guessTarget) files')
 748
 749   -- NOTE: we used to do the dependency anal first, so that if it
 750   -- fails we didn't throw away the current set of modules.  This would
 751   -- require some re-working of the GHC interface, so we'll leave it
 752   -- as a ToDo for now.
 753
 754   io (GHC.setTargets session targets)
 755   ok <- io (GHC.load session LoadAllTargets)
 756   afterLoad ok session
 757   return ok
 758
 759 checkModule :: String -> GHCi ()
 760 checkModule m = do
 761   let modl = GHC.mkModuleName m
 762   session <- getSession
 763   result <- io (GHC.checkModule session modl)
 764   case result of
 765     Nothing -> io $ putStrLn "Nothing"
 766     Just r  -> io $ putStrLn (showSDoc (
 767         case GHC.checkedModuleInfo r of
 768            Just cm | Just scope <- GHC.modInfoTopLevelScope cm ->
 769                 let
 770                     (local,global) = partition ((== modl) . GHC.moduleName . GHC.nameModule) scope
 771                 in
 772                         (text "global names: " <+> ppr global) $$
 773                         (text "local  names: " <+> ppr local)
 774            _ -> empty))
 775   afterLoad (successIf (isJust result)) session
 776
 777 reloadModule :: String -> GHCi ()
 778 reloadModule "" = do
 779   io (revertCAFs)               -- always revert CAFs on reload.
 780   session <- getSession
 781   ok <- io (GHC.load session LoadAllTargets)
 782   afterLoad ok session
 783 reloadModule m = do
 784   io (revertCAFs)               -- always revert CAFs on reload.
 785   session <- getSession
 786   ok <- io (GHC.load session (LoadUpTo (GHC.mkModuleName m)))
 787   afterLoad ok session
 788
 789 afterLoad ok session = do
 790   io (revertCAFs)  -- always revert CAFs on load.
 791   discardResumeContext
 792   discardTickArrays
 793   discardActiveBreakPoints
 794   graph <- io (GHC.getModuleGraph session)
 795   graph' <- filterM (io . GHC.isLoaded session . GHC.ms_mod_name) graph
 796   setContextAfterLoad session graph'
 797   modulesLoadedMsg ok (map GHC.ms_mod_name graph')
 798
 799 setContextAfterLoad session [] = do
 800   prel_mod <- getPrelude
 801   io (GHC.setContext session [] [prel_mod])
 802 setContextAfterLoad session ms = do
 803   -- load a target if one is available, otherwise load the topmost module.
 804   targets <- io (GHC.getTargets session)
 805   case [ m | Just m <- map (findTarget ms) targets ] of
 806         []    ->
 807           let graph' = flattenSCCs (GHC.topSortModuleGraph True ms Nothing) in
 808           load_this (last graph')
 809         (m:_) ->
 810           load_this m
 811  where
 812    findTarget ms t
 813     = case filter (`matches` t) ms of
 814         []    -> Nothing
 815         (m:_) -> Just m
 816
 817    summary `matches` Target (TargetModule m) _
 818         = GHC.ms_mod_name summary == m
 819    summary `matches` Target (TargetFile f _) _
 820         | Just f' <- GHC.ml_hs_file (GHC.ms_location summary)   = f == f'
 821    summary `matches` target
 822         = False
 823
 824    load_this summary | m <- GHC.ms_mod summary = do
 825         b <- io (GHC.moduleIsInterpreted session m)
 826         if b then io (GHC.setContext session [m] [])
 827              else do
 828                    prel_mod <- getPrelude
 829                    io (GHC.setContext session []  [prel_mod,m])
 830
 831
 832 modulesLoadedMsg :: SuccessFlag -> [ModuleName] -> GHCi ()
 833 modulesLoadedMsg ok mods = do
 834   dflags <- getDynFlags
 835   when (verbosity dflags > 0) $ do
 836    let mod_commas
 837         | null mods = text "none."
 838         | otherwise = hsep (
 839             punctuate comma (map ppr mods)) <> text "."
 840    case ok of
 841     Failed ->
 842        io (putStrLn (showSDoc (text "Failed, modules loaded: " <> mod_commas)))
 843     Succeeded  ->
 844        io (putStrLn (showSDoc (text "Ok, modules loaded: " <> mod_commas)))
 845
 846
 847 typeOfExpr :: String -> GHCi ()
 848 typeOfExpr str
 849   = do cms <- getSession
 850        maybe_ty <- io (GHC.exprType cms str)
 851        case maybe_ty of
 852           Nothing -> return ()
 853           Just ty -> do ty' <- cleanType ty
 854                         printForUser $ text str <> text " :: " <> ppr ty'
 855
 856 kindOfType :: String -> GHCi ()
 857 kindOfType str
 858   = do cms <- getSession
 859        maybe_ty <- io (GHC.typeKind cms str)
 860        case maybe_ty of
 861           Nothing    -> return ()
 862           Just ty    -> printForUser $ text str <> text " :: " <> ppr ty
 863
 864 quit :: String -> GHCi Bool
 865 quit _ = return True
 866
 867 shellEscape :: String -> GHCi Bool
 868 shellEscape str = io (system str >> return False)
 869
 870 -----------------------------------------------------------------------------
 871 -- create tags file for currently loaded modules.
 872
 873 createETagsFileCmd, createCTagsFileCmd :: String -> GHCi ()
 874
 875 createCTagsFileCmd ""   = ghciCreateTagsFile CTags "tags"
 876 createCTagsFileCmd file = ghciCreateTagsFile CTags file
 877
 878 createETagsFileCmd ""    = ghciCreateTagsFile ETags "TAGS"
 879 createETagsFileCmd file  = ghciCreateTagsFile ETags file
 880
 881 data TagsKind = ETags | CTags
 882
 883 ghciCreateTagsFile :: TagsKind -> FilePath -> GHCi ()
 884 ghciCreateTagsFile kind file = do
 885   session <- getSession
 886   io $ createTagsFile session kind file
 887
 888 -- ToDo:
 889 --      - remove restriction that all modules must be interpreted
 890 --        (problem: we don't know source locations for entities unless
 891 --        we compiled the module.
 892 --
 893 --      - extract createTagsFile so it can be used from the command-line
 894 --        (probably need to fix first problem before this is useful).
 895 --
 896 createTagsFile :: Session -> TagsKind -> FilePath -> IO ()
 897 createTagsFile session tagskind tagFile = do
 898   graph <- GHC.getModuleGraph session
 899   let ms = map GHC.ms_mod graph
 900       tagModule m = do
 901         is_interpreted <- GHC.moduleIsInterpreted session m
 902         -- should we just skip these?
 903         when (not is_interpreted) $
 904           throwDyn (CmdLineError ("module '"
 905                                 ++ GHC.moduleNameString (GHC.moduleName m)
 906                                 ++ "' is not interpreted"))
 907         mbModInfo <- GHC.getModuleInfo session m
 908         let unqual
 909               | Just modinfo <- mbModInfo,
 910                 Just unqual <- GHC.modInfoPrintUnqualified modinfo = unqual
 911               | otherwise = GHC.alwaysQualify
 912
 913         case mbModInfo of
 914           Just modInfo -> return $! listTags unqual modInfo
 915           _            -> return []
 916
 917   mtags <- mapM tagModule ms
 918   either_res <- collateAndWriteTags tagskind tagFile $ concat mtags
 919   case either_res of
 920     Left e  -> hPutStrLn stderr $ ioeGetErrorString e
 921     Right _ -> return ()
 922
 923 listTags :: PrintUnqualified -> GHC.ModuleInfo -> [TagInfo]
 924 listTags unqual modInfo =
 925            [ tagInfo unqual name loc
 926            | name <- GHC.modInfoExports modInfo
 927            , let loc = nameSrcLoc name
 928            , isGoodSrcLoc loc
 929            ]
 930
 931 type TagInfo = (String -- tag name
 932                ,String -- file name
 933                ,Int    -- line number
 934                ,Int    -- column number
 935                )
 936
 937 -- get tag info, for later translation into Vim or Emacs style
 938 tagInfo :: PrintUnqualified -> Name -> SrcLoc -> TagInfo
 939 tagInfo unqual name loc
 940     = ( showSDocForUser unqual $ pprOccName (nameOccName name)
 941       , showSDocForUser unqual $ ftext (srcLocFile loc)
 942       , srcLocLine loc
 943       , srcLocCol loc
 944       )
 945
 946 collateAndWriteTags :: TagsKind -> FilePath -> [TagInfo] -> IO (Either IOError ())
 947 collateAndWriteTags CTags file tagInfos = do -- ctags style, Vim et al
 948   let tags = unlines $ sortLe (<=) $ nub $ map showTag tagInfos
 949   IO.try (writeFile file tags)
 950 collateAndWriteTags ETags file tagInfos = do -- etags style, Emacs/XEmacs
 951   let byFile op (_,f1,_,_) (_,f2,_,_) = f1 `op` f2
 952       groups = groupBy (byFile (==)) $ sortLe (byFile (<=)) tagInfos
 953   tagGroups <- mapM tagFileGroup groups
 954   IO.try (writeFile file $ concat tagGroups)
 955   where
 956     tagFileGroup group@[] = throwDyn (CmdLineError "empty tag file group??")
 957     tagFileGroup group@((_,fileName,_,_):_) = do
 958       file <- readFile fileName -- need to get additional info from sources..
 959       let byLine (_,_,l1,_) (_,_,l2,_) = l1 <= l2
 960           sortedGroup = sortLe byLine group
 961           tags = unlines $ perFile sortedGroup 1 0 $ lines file
 962       return $ "\x0c\n" ++ fileName ++ "," ++ show (length tags) ++ "\n" ++ tags
 963     perFile (tagInfo@(tag,file,lNo,colNo):tags) count pos (line:lines) | lNo>count =
 964       perFile (tagInfo:tags) (count+1) (pos+length line) lines
 965     perFile (tagInfo@(tag,file,lNo,colNo):tags) count pos lines@(line:_) | lNo==count =
 966       showETag tagInfo line pos : perFile tags count pos lines
 967     perFile tags count pos lines = []
 968
 969 -- simple ctags format, for Vim et al
 970 showTag :: TagInfo -> String
 971 showTag (tag,file,lineNo,colNo)
 972     =  tag ++ "\t" ++ file ++ "\t" ++ show lineNo
 973
 974 -- etags format, for Emacs/XEmacs
 975 showETag :: TagInfo -> String -> Int -> String
 976 showETag (tag,file,lineNo,colNo) line charPos
 977     =  take colNo line ++ tag
 978     ++ "\x7f" ++ tag
 979     ++ "\x01" ++ show lineNo
 980     ++ "," ++ show charPos
 981
 982 -----------------------------------------------------------------------------
 983 -- Browsing a module's contents
 984
 985 browseCmd :: String -> GHCi ()
 986 browseCmd m =
 987   case words m of
 988     ['*':m] | looksLikeModuleName m -> browseModule m False
 989     [m]     | looksLikeModuleName m -> browseModule m True
 990     _ -> throwDyn (CmdLineError "syntax:  :browse <module>")
 991
 992 browseModule m exports_only = do
 993   s <- getSession
 994   modl <- if exports_only then lookupModule s m
 995                           else wantInterpretedModule s m
 996
 997   -- Temporarily set the context to the module we're interested in,
 998   -- just so we can get an appropriate PrintUnqualified
 999   (as,bs) <- io (GHC.getContext s)
1000   prel_mod <- getPrelude
1001   io (if exports_only then GHC.setContext s [] [prel_mod,modl]
1002                       else GHC.setContext s [modl] [])
1003   unqual <- io (GHC.getPrintUnqual s)
1004   io (GHC.setContext s as bs)
1005
1006   mb_mod_info <- io $ GHC.getModuleInfo s modl
1007   case mb_mod_info of
1008     Nothing -> throwDyn (CmdLineError ("unknown module: " ++ m))
1009     Just mod_info -> do
1010         let names
1011                | exports_only = GHC.modInfoExports mod_info
1012                | otherwise    = fromMaybe [] (GHC.modInfoTopLevelScope mod_info)
1013
1014             filtered = filterOutChildren names
1015
1016         things <- io $ mapM (GHC.lookupName s) filtered
1017
1018         dflags <- getDynFlags
1019         let exts = dopt Opt_GlasgowExts dflags
1020         io (putStrLn (showSDocForUser unqual (
1021                 vcat (map (pprTyThingInContext exts) (catMaybes things))
1022            )))
1023         -- ToDo: modInfoInstances currently throws an exception for
1024         -- package modules.  When it works, we can do this:
1025         --      $$ vcat (map GHC.pprInstance (GHC.modInfoInstances mod_info))
1026
1027 -----------------------------------------------------------------------------
1028 -- Setting the module context
1029
1030 setContext str
1031   | all sensible mods = fn mods
1032   | otherwise = throwDyn (CmdLineError "syntax:  :module [+/-] [*]M1 ... [*]Mn")
1033   where
1034     (fn, mods) = case str of
1035                         '+':stuff -> (addToContext,      words stuff)
1036                         '-':stuff -> (removeFromContext, words stuff)
1037                         stuff     -> (newContext,        words stuff)
1038
1039     sensible ('*':m) = looksLikeModuleName m
1040     sensible m       = looksLikeModuleName m
1041
1042 separate :: Session -> [String] -> [Module] -> [Module]
1043         -> GHCi ([Module],[Module])
1044 separate session []           as bs = return (as,bs)
1045 separate session (('*':str):ms) as bs = do
1046    m <- io $ GHC.findModule session (GHC.mkModuleName str) Nothing
1047    b <- io $ GHC.moduleIsInterpreted session m
1048    if b then separate session ms (m:as) bs
1049         else throwDyn (CmdLineError ("module '"
1050                         ++ GHC.moduleNameString (GHC.moduleName m)
1051                         ++ "' is not interpreted"))
1052 separate session (str:ms) as bs = do
1053   m <- io $ GHC.findModule session (GHC.mkModuleName str) Nothing
1054   separate session ms as (m:bs)
1055
1056 newContext :: [String] -> GHCi ()
1057 newContext strs = do
1058   s <- getSession
1059   (as,bs) <- separate s strs [] []
1060   prel_mod <- getPrelude
1061   let bs' = if null as && prel_mod `notElem` bs then prel_mod:bs else bs
1062   io $ GHC.setContext s as bs'
1063
1064
1065 addToContext :: [String] -> GHCi ()
1066 addToContext strs = do
1067   s <- getSession
1068   (as,bs) <- io $ GHC.getContext s
1069
1070   (new_as,new_bs) <- separate s strs [] []
1071
1072   let as_to_add = new_as \\ (as ++ bs)
1073       bs_to_add = new_bs \\ (as ++ bs)
1074
1075   io $ GHC.setContext s (as ++ as_to_add) (bs ++ bs_to_add)
1076
1077
1078 removeFromContext :: [String] -> GHCi ()
1079 removeFromContext strs = do
1080   s <- getSession
1081   (as,bs) <- io $ GHC.getContext s
1082
1083   (as_to_remove,bs_to_remove) <- separate s strs [] []
1084
1085   let as' = as \\ (as_to_remove ++ bs_to_remove)
1086       bs' = bs \\ (as_to_remove ++ bs_to_remove)
1087
1088   io $ GHC.setContext s as' bs'
1089
1090 ----------------------------------------------------------------------------
1091 -- Code for `:set'
1092
1093 -- set options in the interpreter.  Syntax is exactly the same as the
1094 -- ghc command line, except that certain options aren't available (-C,
1095 -- -E etc.)
1096 --
1097 -- This is pretty fragile: most options won't work as expected.  ToDo:
1098 -- figure out which ones & disallow them.
1099
1100 setCmd :: String -> GHCi ()
1101 setCmd ""
1102   = do st <- getGHCiState
1103        let opts = options st
1104        io $ putStrLn (showSDoc (
1105               text "options currently set: " <>
1106               if null opts
1107                    then text "none."
1108                    else hsep (map (\o -> char '+' <> text (optToStr o)) opts)
1109            ))
1110 setCmd str
1111   = case toArgs str of
1112         ("args":args) -> setArgs args
1113         ("prog":prog) -> setProg prog
1114         ("prompt":prompt) -> setPrompt (after 6)
1115         ("editor":cmd) -> setEditor (after 6)
1116         ("stop":cmd) -> setStop (after 4)
1117         wds -> setOptions wds
1118    where after n = dropWhile isSpace $ drop n $ dropWhile isSpace str
1119
1120 setArgs args = do
1121   st <- getGHCiState
1122   setGHCiState st{ args = args }
1123
1124 setProg [prog] = do
1125   st <- getGHCiState
1126   setGHCiState st{ progname = prog }
1127 setProg _ = do
1128   io (hPutStrLn stderr "syntax: :set prog <progname>")
1129
1130 setEditor cmd = do
1131   st <- getGHCiState
1132   setGHCiState st{ editor = cmd }
1133
1134 setStop cmd = do
1135   st <- getGHCiState
1136   setGHCiState st{ stop = cmd }
1137
1138 setPrompt value = do
1139   st <- getGHCiState
1140   if null value
1141       then io $ hPutStrLn stderr $ "syntax: :set prompt <prompt>, currently \"" ++ prompt st ++ "\""
1142       else setGHCiState st{ prompt = remQuotes value }
1143   where
1144      remQuotes ('\"':xs) | not (null xs) && last xs == '\"' = init xs
1145      remQuotes x = x
1146
1147 setOptions wds =
1148    do -- first, deal with the GHCi opts (+s, +t, etc.)
1149       let (plus_opts, minus_opts)  = partition isPlus wds
1150       mapM_ setOpt plus_opts
1151
1152       -- then, dynamic flags
1153       dflags <- getDynFlags
1154       let pkg_flags = packageFlags dflags
1155       (dflags',leftovers) <- io $ GHC.parseDynamicFlags dflags minus_opts
1156
1157       if (not (null leftovers))
1158                 then throwDyn (CmdLineError ("unrecognised flags: " ++
1159                                                 unwords leftovers))
1160                 else return ()
1161
1162       new_pkgs <- setDynFlags dflags'
1163
1164       -- if the package flags changed, we should reset the context
1165       -- and link the new packages.
1166       dflags <- getDynFlags
1167       when (packageFlags dflags /= pkg_flags) $ do
1168         io $ hPutStrLn stderr "package flags have changed, ressetting and loading new packages..."
1169         session <- getSession
1170         io (GHC.setTargets session [])
1171         io (GHC.load session LoadAllTargets)
1172         io (linkPackages dflags new_pkgs)
1173         setContextAfterLoad session []
1174       return ()
1175
1176
1177 unsetOptions :: String -> GHCi ()
1178 unsetOptions str
1179   = do -- first, deal with the GHCi opts (+s, +t, etc.)
1180        let opts = words str
1181            (minus_opts, rest1) = partition isMinus opts
1182            (plus_opts, rest2)  = partition isPlus rest1
1183
1184        if (not (null rest2))
1185           then io (putStrLn ("unknown option: '" ++ head rest2 ++ "'"))
1186           else do
1187
1188        mapM_ unsetOpt plus_opts
1189
1190        -- can't do GHC flags for now
1191        if (not (null minus_opts))
1192           then throwDyn (CmdLineError "can't unset GHC command-line flags")
1193           else return ()
1194
1195 isMinus ('-':s) = True
1196 isMinus _ = False
1197
1198 isPlus ('+':s) = True
1199 isPlus _ = False
1200
1201 setOpt ('+':str)
1202   = case strToGHCiOpt str of
1203         Nothing -> io (putStrLn ("unknown option: '" ++ str ++ "'"))
1204         Just o  -> setOption o
1205
1206 unsetOpt ('+':str)
1207   = case strToGHCiOpt str of
1208         Nothing -> io (putStrLn ("unknown option: '" ++ str ++ "'"))
1209         Just o  -> unsetOption o
1210
1211 strToGHCiOpt :: String -> (Maybe GHCiOption)
1212 strToGHCiOpt "s" = Just ShowTiming
1213 strToGHCiOpt "t" = Just ShowType
1214 strToGHCiOpt "r" = Just RevertCAFs
1215 strToGHCiOpt _   = Nothing
1216
1217 optToStr :: GHCiOption -> String
1218 optToStr ShowTiming = "s"
1219 optToStr ShowType   = "t"
1220 optToStr RevertCAFs = "r"
1221
1222 -- ---------------------------------------------------------------------------
1223 -- code for `:show'
1224
1225 showCmd str =
1226   case words str of
1227         ["modules" ] -> showModules
1228         ["bindings"] -> showBindings
1229         ["linker"]   -> io showLinkerState
1230         ["breaks"] -> showBkptTable
1231         ["context"] -> showContext
1232         _ -> throwDyn (CmdLineError "syntax:  :show [modules|bindings|breaks]")
1233
1234 showModules = do
1235   session <- getSession
1236   let show_one ms = do m <- io (GHC.showModule session ms)
1237                        io (putStrLn m)
1238   graph <- io (GHC.getModuleGraph session)
1239   mapM_ show_one graph
1240
1241 showBindings = do
1242   s <- getSession
1243   unqual <- io (GHC.getPrintUnqual s)
1244   bindings <- io (GHC.getBindings s)
1245   mapM_ showTyThing bindings
1246   return ()
1247
1248 showTyThing (AnId id) = do
1249   ty' <- cleanType (GHC.idType id)
1250   printForUser $ ppr id <> text " :: " <> ppr ty'
1251 showTyThing _  = return ()
1252
1253 -- if -fglasgow-exts is on we show the foralls, otherwise we don't.
1254 cleanType :: Type -> GHCi Type
1255 cleanType ty = do
1256   dflags <- getDynFlags
1257   if dopt Opt_GlasgowExts dflags
1258         then return ty
1259         else return $! GHC.dropForAlls ty
1260
1261 showBkptTable :: GHCi ()
1262 showBkptTable = do
1263    activeBreaks <- getActiveBreakPoints
1264    printForUser $ ppr activeBreaks
1265
1266 showContext :: GHCi ()
1267 showContext = do
1268    st <- getGHCiState
1269    printForUser $ vcat (map pp_resume (resume st))
1270   where
1271    pp_resume (span, _, _) = ptext SLIT("Stopped at") <+> ppr span
1272
1273 -- -----------------------------------------------------------------------------
1274 -- Completion
1275
1276 completeNone :: String -> IO [String]
1277 completeNone w = return []
1278
1279 #ifdef USE_READLINE
1280 completeWord :: String -> Int -> Int -> IO (Maybe (String, [String]))
1281 completeWord w start end = do
1282   line <- Readline.getLineBuffer
1283   case w of
1284      ':':_ | all isSpace (take (start-1) line) -> wrapCompleter completeCmd w
1285      _other
1286         | Just c <- is_cmd line -> do
1287            maybe_cmd <- lookupCommand c
1288            let (n,w') = selectWord (words' 0 line)
1289            case maybe_cmd of
1290              Nothing -> return Nothing
1291              Just (_,_,False,complete) -> wrapCompleter complete w
1292              Just (_,_,True,complete) -> let complete' w = do rets <- complete w
1293                                                               return (map (drop n) rets)
1294                                          in wrapCompleter complete' w'
1295         | otherwise     -> do
1296                 --printf "complete %s, start = %d, end = %d\n" w start end
1297                 wrapCompleter completeIdentifier w
1298     where words' _ [] = []
1299           words' n str = let (w,r) = break isSpace str
1300                              (s,r') = span isSpace r
1301                          in (n,w):words' (n+length w+length s) r'
1302           -- In a Haskell expression we want to parse 'a-b' as three words
1303           -- where a compiler flag (ie. -fno-monomorphism-restriction) should
1304           -- only be a single word.
1305           selectWord [] = (0,w)
1306           selectWord ((offset,x):xs)
1307               | offset+length x >= start = (start-offset,take (end-offset) x)
1308               | otherwise = selectWord xs
1309
1310 is_cmd line
1311  | ((':':w) : _) <- words (dropWhile isSpace line) = Just w
1312  | otherwise = Nothing
1313
1314 completeCmd w = do
1315   cmds <- readIORef commands
1316   return (filter (w `isPrefixOf`) (map (':':) (map cmdName cmds)))
1317
1318 completeMacro w = do
1319   cmds <- readIORef commands
1320   let cmds' = [ cmd | cmd <- map cmdName cmds, cmd `elem` map cmdName builtin_commands ]
1321   return (filter (w `isPrefixOf`) cmds')
1322
1323 completeIdentifier w = do
1324   s <- restoreSession
1325   rdrs <- GHC.getRdrNamesInScope s
1326   return (filter (w `isPrefixOf`) (map (showSDoc.ppr) rdrs))
1327
1328 completeModule w = do
1329   s <- restoreSession
1330   dflags <- GHC.getSessionDynFlags s
1331   let pkg_mods = allExposedModules dflags
1332   return (filter (w `isPrefixOf`) (map (showSDoc.ppr) pkg_mods))
1333
1334 completeHomeModule w = do
1335   s <- restoreSession
1336   g <- GHC.getModuleGraph s
1337   let home_mods = map GHC.ms_mod_name g
1338   return (filter (w `isPrefixOf`) (map (showSDoc.ppr) home_mods))
1339
1340 completeSetOptions w = do
1341   return (filter (w `isPrefixOf`) options)
1342     where options = "args":"prog":allFlags
1343
1344 completeFilename = Readline.filenameCompletionFunction
1345
1346 completeHomeModuleOrFile = unionComplete completeHomeModule completeFilename
1347
1348 unionComplete :: (String -> IO [String]) -> (String -> IO [String]) -> String -> IO [String]
1349 unionComplete f1 f2 w = do
1350   s1 <- f1 w
1351   s2 <- f2 w
1352   return (s1 ++ s2)
1353
1354 wrapCompleter :: (String -> IO [String]) -> String -> IO (Maybe (String,[String]))
1355 wrapCompleter fun w =  do
1356   strs <- fun w
1357   case strs of
1358     []  -> return Nothing
1359     [x] -> return (Just (x,[]))
1360     xs  -> case getCommonPrefix xs of
1361                 ""   -> return (Just ("",xs))
1362                 pref -> return (Just (pref,xs))
1363
1364 getCommonPrefix :: [String] -> String
1365 getCommonPrefix [] = ""
1366 getCommonPrefix (s:ss) = foldl common s ss
1367   where common s "" = ""
1368         common "" s = ""
1369         common (c:cs) (d:ds)
1370            | c == d = c : common cs ds
1371            | otherwise = ""
1372
1373 allExposedModules :: DynFlags -> [ModuleName]
1374 allExposedModules dflags
1375  = map GHC.mkModuleName (concat (map exposedModules (filter exposed (eltsUFM pkg_db))))
1376  where
1377   pkg_db = pkgIdMap (pkgState dflags)
1378 #else
1379 completeCmd        = completeNone
1380 completeMacro      = completeNone
1381 completeIdentifier = completeNone
1382 completeModule     = completeNone
1383 completeHomeModule = completeNone
1384 completeSetOptions = completeNone
1385 completeFilename   = completeNone
1386 completeHomeModuleOrFile=completeNone
1387 completeBkpt       = completeNone
1388 #endif
1389
1390 -- ---------------------------------------------------------------------------
1391 -- User code exception handling
1392
1393 -- This is the exception handler for exceptions generated by the
1394 -- user's code and exceptions coming from children sessions;
1395 -- it normally just prints out the exception.  The
1396 -- handler must be recursive, in case showing the exception causes
1397 -- more exceptions to be raised.
1398 --
1399 -- Bugfix: if the user closed stdout or stderr, the flushing will fail,
1400 -- raising another exception.  We therefore don't put the recursive
1401 -- handler arond the flushing operation, so if stderr is closed
1402 -- GHCi will just die gracefully rather than going into an infinite loop.
1403 handler :: Exception -> GHCi Bool
1404
1405 handler exception = do
1406   flushInterpBuffers
1407   io installSignalHandlers
1408   ghciHandle handler (showException exception >> return False)
1409
1410 showException (DynException dyn) =
1411   case fromDynamic dyn of
1412     Nothing               -> io (putStrLn ("*** Exception: (unknown)"))
1413     Just Interrupted      -> io (putStrLn "Interrupted.")
1414     Just (CmdLineError s) -> io (putStrLn s)     -- omit the location for CmdLineError
1415     Just ph@PhaseFailed{} -> io (putStrLn (showGhcException ph "")) -- ditto
1416     Just other_ghc_ex     -> io (print other_ghc_ex)
1417
1418 showException other_exception
1419   = io (putStrLn ("*** Exception: " ++ show other_exception))
1420
1421 -----------------------------------------------------------------------------
1422 -- recursive exception handlers
1423
1424 -- Don't forget to unblock async exceptions in the handler, or if we're
1425 -- in an exception loop (eg. let a = error a in a) the ^C exception
1426 -- may never be delivered.  Thanks to Marcin for pointing out the bug.
1427
1428 ghciHandle :: (Exception -> GHCi a) -> GHCi a -> GHCi a
1429 ghciHandle h (GHCi m) = GHCi $ \s ->
1430    Exception.catch (m s)
1431         (\e -> unGHCi (ghciUnblock (h e)) s)
1432
1433 ghciUnblock :: GHCi a -> GHCi a
1434 ghciUnblock (GHCi a) = GHCi $ \s -> Exception.unblock (a s)
1435
1436
1437 -- ----------------------------------------------------------------------------
1438 -- Utils
1439
1440 expandPath :: String -> GHCi String
1441 expandPath path =
1442   case dropWhile isSpace path of
1443    ('~':d) -> do
1444         tilde <- io (getEnv "HOME")     -- will fail if HOME not defined
1445         return (tilde ++ '/':d)
1446    other ->
1447         return other
1448
1449 -- ----------------------------------------------------------------------------
1450 -- Windows console setup
1451
1452 setUpConsole :: IO ()
1453 setUpConsole = do
1454 #ifdef mingw32_HOST_OS
1455         -- On Windows we need to set a known code page, otherwise the characters
1456         -- we read from the console will be be in some strange encoding, and
1457         -- similarly for characters we write to the console.
1458         --
1459         -- At the moment, GHCi pretends all input is Latin-1.  In the
1460         -- future we should support UTF-8, but for now we set the code pages
1461         -- to Latin-1.
1462         --
1463         -- It seems you have to set the font in the console window to
1464         -- a Unicode font in order for output to work properly,
1465         -- otherwise non-ASCII characters are mapped wrongly.  sigh.
1466         -- (see MSDN for SetConsoleOutputCP()).
1467         --
1468         setConsoleCP 28591       -- ISO Latin-1
1469         setConsoleOutputCP 28591 -- ISO Latin-1
1470 #endif
1471         return ()
1472
1473 -- -----------------------------------------------------------------------------
1474 -- commands for debugger
1475
1476 foreign import ccall "rts_setStepFlag" setStepFlag :: IO ()
1477
1478 stepCmd :: String -> GHCi Bool
1479 stepCmd [] = doContinue setStepFlag
1480 stepCmd expression = do
1481    io $ setStepFlag
1482    runCommand expression
1483
1484 continueCmd :: String -> GHCi Bool
1485 continueCmd [] = doContinue $ return ()
1486 continueCmd other = do
1487    io $ putStrLn "The continue command accepts no arguments."
1488    return False
1489
1490 doContinue :: IO () -> GHCi Bool
1491 doContinue actionBeforeCont = do
1492    resumeAction <- popResume
1493    case resumeAction of
1494       Nothing -> do
1495          io $ putStrLn "There is no computation running."
1496          return False
1497       Just (_,_,handle) -> do
1498          io $ actionBeforeCont
1499          session <- getSession
1500          runResult <- io $ GHC.resume session handle
1501          names <- switchOnRunResult runResult
1502          finishEvalExpr names
1503          return False
1504
1505 deleteCmd :: String -> GHCi ()
1506 deleteCmd argLine = do
1507    deleteSwitch $ words argLine
1508    where
1509    deleteSwitch :: [String] -> GHCi ()
1510    deleteSwitch [] =
1511       io $ putStrLn "The delete command requires at least one argument."
1512    -- delete all break points
1513    deleteSwitch ("*":_rest) = discardActiveBreakPoints
1514    deleteSwitch idents = do
1515       mapM_ deleteOneBreak idents
1516       where
1517       deleteOneBreak :: String -> GHCi ()
1518       deleteOneBreak str
1519          | all isDigit str = deleteBreak (read str)
1520          | otherwise = return ()
1521
1522 -- handle the "break" command
1523 breakCmd :: String -> GHCi ()
1524 breakCmd argLine = do
1525    session <- getSession
1526    breakSwitch session $ words argLine
1527
1528 breakSwitch :: Session -> [String] -> GHCi ()
1529 breakSwitch _session [] = do
1530    io $ putStrLn "The break command requires at least one argument."
1531 breakSwitch session args@(arg1:rest)
1532    | looksLikeModuleName arg1 = do
1533         mod <- wantInterpretedModule session arg1
1534         breakByModule session mod rest
1535    | all isDigit arg1 = do
1536         (toplevel, _) <- io $ GHC.getContext session
1537         case toplevel of
1538            (mod : _) -> breakByModuleLine mod (read arg1) rest
1539            [] -> do
1540               io $ putStrLn "Cannot find default module for breakpoint."
1541               io $ putStrLn "Perhaps no modules are loaded for debugging?"
1542    | otherwise = do -- assume it's a name
1543         names <- io $ GHC.parseName session arg1
1544         case names of
1545           []    -> return ()
1546           (n:_) -> do
1547             let loc  = nameSrcLoc n
1548                 modl = nameModule n
1549             is_interpreted <- io (GHC.moduleIsInterpreted session modl)
1550             if not is_interpreted
1551                then noCanDo $ text "module " <> ppr modl <>
1552                               text " is not interpreted"
1553                else do
1554             if isGoodSrcLoc loc
1555                then findBreakAndSet (nameModule n) $
1556                          findBreakByCoord (srcLocLine loc, srcLocCol loc)
1557                else noCanDo $ text "can't find its location: " <>
1558                               ppr loc
1559            where
1560              noCanDo why = printForUser $
1561                 text "cannot set breakpoint on " <> ppr n <> text ": " <> why
1562
1563
1564 wantInterpretedModule :: Session -> String -> GHCi Module
1565 wantInterpretedModule session str = do
1566    modl <- io $ GHC.findModule session (GHC.mkModuleName str) Nothing
1567    is_interpreted <- io (GHC.moduleIsInterpreted session modl)
1568    when (not is_interpreted) $
1569        throwDyn (CmdLineError ("module '" ++ str ++ "' is not interpreted"))
1570    return modl
1571
1572 breakByModule :: Session -> Module -> [String] -> GHCi ()
1573 breakByModule session mod args@(arg1:rest)
1574    | all isDigit arg1 = do  -- looks like a line number
1575         breakByModuleLine mod (read arg1) rest
1576    | otherwise = io $ putStrLn "Invalid arguments to :break"
1577
1578 breakByModuleLine :: Module -> Int -> [String] -> GHCi ()
1579 breakByModuleLine mod line args
1580    | [] <- args = findBreakAndSet mod $ findBreakByLine line
1581    | [col] <- args, all isDigit col =
1582         findBreakAndSet mod $ findBreakByCoord (line, read col)
1583    | otherwise = io $ putStrLn "Invalid arguments to :break"
1584
1585 findBreakAndSet :: Module -> (TickArray -> Maybe (Int, SrcSpan)) -> GHCi ()
1586 findBreakAndSet mod lookupTickTree = do
1587    tickArray <- getTickArray mod
1588    (breakArray, _) <- getModBreak mod
1589    case lookupTickTree tickArray of
1590       Nothing  -> io $ putStrLn $ "No breakpoints found at that location."
1591       Just (tick, span) -> do
1592          success <- io $ setBreakFlag True breakArray tick
1593          session <- getSession
1594          if success
1595             then do
1596                (alreadySet, nm) <-
1597                      recordBreak $ BreakLocation
1598                              { breakModule = mod
1599                              , breakLoc = span
1600                              , breakTick = tick
1601                              }
1602                printForUser $
1603                   text "Breakpoint " <> ppr nm <>
1604                   if alreadySet
1605                      then text " was already set at " <> ppr span
1606                      else text " activated at " <> ppr span
1607             else do
1608             printForUser $ text "Breakpoint could not be activated at"
1609                                  <+> ppr span
1610
1611 -- When a line number is specified, the current policy for choosing
1612 -- the best breakpoint is this:
1613 --    - the leftmost complete subexpression on the specified line, or
1614 --    - the leftmost subexpression starting on the specified line, or
1615 --    - the rightmost subexpression enclosing the specified line
1616 --
1617 findBreakByLine :: Int -> TickArray -> Maybe (BreakIndex,SrcSpan)
1618 findBreakByLine line arr
1619   | not (inRange (bounds arr) line) = Nothing
1620   | otherwise =
1621     listToMaybe (sortBy leftmost_largest  complete)   `mplus`
1622     listToMaybe (sortBy leftmost_smallest incomplete) `mplus`
1623     listToMaybe (sortBy rightmost ticks)
1624   where
1625         ticks = arr ! line
1626
1627         starts_here = [ tick | tick@(nm,span) <- ticks,
1628                                srcSpanStartLine span == line ]
1629
1630         (complete,incomplete) = partition ends_here starts_here
1631             where ends_here (nm,span) = srcSpanEndLine span == line
1632
1633 findBreakByCoord :: (Int,Int) -> TickArray -> Maybe (BreakIndex,SrcSpan)
1634 findBreakByCoord (line, col) arr
1635   | not (inRange (bounds arr) line) = Nothing
1636   | otherwise =
1637     listToMaybe (sortBy rightmost contains)
1638   where
1639         ticks = arr ! line
1640
1641         -- the ticks that span this coordinate
1642         contains = [ tick | tick@(nm,span) <- ticks, span `spans` (line,col) ]
1643
1644 leftmost_smallest  (_,a) (_,b) = a `compare` b
1645 leftmost_largest   (_,a) (_,b) = (srcSpanStart a `compare` srcSpanStart b)
1646                                 `thenCmp`
1647                                  (srcSpanEnd b `compare` srcSpanEnd a)
1648 rightmost (_,a) (_,b) = b `compare` a
1649
1650 spans :: SrcSpan -> (Int,Int) -> Bool
1651 spans span (l,c) = srcSpanStart span <= loc && loc <= srcSpanEnd span
1652    where loc = mkSrcLoc (srcSpanFile span) l c
1653
1654 start_bold = BS.pack "\ESC[1m"
1655 end_bold   = BS.pack "\ESC[0m"
1656
1657 listCmd :: String -> GHCi ()
1658 listCmd str = do
1659    st <- getGHCiState
1660    case resume st of
1661       []  -> printForUser $ text "not stopped at a breakpoint; nothing to list"
1662       (span,_,_):_ -> io $ listAround span True
1663
1664 -- | list a section of a source file around a particular SrcSpan.
1665 -- If the highlight flag is True, also highlight the span using
1666 -- start_bold/end_bold.
1667 listAround span do_highlight = do
1668       contents <- BS.readFile (unpackFS file)
1669       let
1670           lines = BS.split '\n' contents
1671           these_lines = take (line2 - line1 + 1 + pad_before + pad_after) $
1672                         drop (line1 - 1 - pad_before) $ lines
1673           fst_line = max 1 (line1 - pad_before)
1674           line_nos = [ fst_line .. ]
1675
1676           highlighted | do_highlight = zipWith highlight line_nos these_lines
1677                       | otherwise   = these_lines
1678
1679           bs_line_nos = [ BS.pack (show l ++ "  ") | l <- line_nos ]
1680           prefixed = zipWith BS.append bs_line_nos highlighted
1681       --
1682       BS.putStrLn (BS.join (BS.pack "\n") prefixed)
1683   where
1684         file  = srcSpanFile span
1685         line1 = srcSpanStartLine span
1686         col1  = srcSpanStartCol span
1687         line2 = srcSpanEndLine span
1688         col2  = srcSpanEndCol span
1689
1690         pad_before | line1 == 1 = 0
1691                    | otherwise  = 1
1692         pad_after = 1
1693
1694         highlight no line
1695           | no == line1 && no == line2
1696           = let (a,r) = BS.splitAt col1 line
1697                 (b,c) = BS.splitAt (col2-col1) r
1698             in
1699             BS.concat [a,start_bold,b,end_bold,c]
1700           | no == line1
1701           = let (a,b) = BS.splitAt col1 line in
1702             BS.concat [a, start_bold, b]
1703           | no == line2
1704           = let (a,b) = BS.splitAt col2 line in
1705             BS.concat [a, end_bold, b]
1706           | otherwise   = line
1707
1708 -- --------------------------------------------------------------------------
1709 -- Tick arrays
1710
1711 getTickArray :: Module -> GHCi TickArray
1712 getTickArray modl = do
1713    st <- getGHCiState
1714    let arrmap = tickarrays st
1715    case lookupModuleEnv arrmap modl of
1716       Just arr -> return arr
1717       Nothing  -> do
1718         (breakArray, ticks) <- getModBreak modl
1719         let arr = mkTickArray (assocs ticks)
1720         setGHCiState st{tickarrays = extendModuleEnv arrmap modl arr}
1721         return arr
1722
1723 discardTickArrays :: GHCi ()
1724 discardTickArrays = do
1725    st <- getGHCiState
1726    setGHCiState st{tickarrays = emptyModuleEnv}
1727
1728 mkTickArray :: [(BreakIndex,SrcSpan)] -> TickArray
1729 mkTickArray ticks
1730   = accumArray (flip (:)) [] (1, max_line)
1731         [ (line, (nm,span)) | (nm,span) <- ticks,
1732                               line <- srcSpanLines span ]
1733     where
1734         max_line = maximum (map srcSpanEndLine (map snd ticks))
1735         srcSpanLines span = [ srcSpanStartLine span .. srcSpanEndLine span ]
1736
1737 getModBreak :: Module -> GHCi (GHC.BreakArray, Array Int SrcSpan)
1738 getModBreak mod = do
1739    session <- getSession
1740    Just mod_info <- io $ GHC.getModuleInfo session mod
1741    let modBreaks  = GHC.modInfoModBreaks mod_info
1742    let array      = GHC.modBreaks_flags modBreaks
1743    let ticks      = GHC.modBreaks_locs  modBreaks
1744    return (array, ticks)
1745
1746 lookupModule :: Session -> String -> GHCi Module
1747 lookupModule session modName
1748    = io (GHC.findModule session (GHC.mkModuleName modName) Nothing)
1749
1750 setBreakFlag :: Bool -> GHC.BreakArray -> Int -> IO Bool
1751 setBreakFlag toggle array index
1752    | toggle    = GHC.setBreakOn array index
1753    | otherwise = GHC.setBreakOff array index
1754
1755
1756 {- these should probably go to the GHC API at some point -}
1757 enableBreakPoint  :: Session -> Module -> Int -> IO ()
1758 enableBreakPoint session mod index = return ()
1759
1760 disableBreakPoint :: Session -> Module -> Int -> IO ()
1761 disableBreakPoint session mod index = return ()
1762
1763 activeBreakPoints :: Session -> IO [(Module,Int)]
1764 activeBreakPoints session = return []
1765
1766 enableSingleStep  :: Session -> IO ()
1767 enableSingleStep session = return ()
1768
1769 disableSingleStep :: Session -> IO ()
1770 disableSingleStep session = return ()