Re-working of the breakpoint support
[ghc-hetmet.git] / compiler / ghci / InteractiveUI.hs
index e7a5a37..b794436 100644 (file)
@@ -13,19 +13,7 @@ module InteractiveUI (
 
 #include "HsVersions.h"
 
-#if defined(GHCI) && defined(BREAKPOINT)
-import GHC.Exts         ( Int(..), Ptr(..), int2Addr# )
-import Foreign.StablePtr ( deRefStablePtr, castPtrToStablePtr )
-import System.IO.Unsafe ( unsafePerformIO )
-import Var
-import HscTypes
-import RdrName
-import NameEnv
-import TcType
-import qualified Id
-import IdInfo
-import PrelNames
-#endif
+import GhciMonad
 
 -- The GHC interface
 import qualified GHC
@@ -45,13 +33,25 @@ import SrcLoc
 
 -- Other random utilities
 import Digraph
-import BasicTypes
-import Panic hiding (showException)
+import BasicTypes hiding (isTopLevel)
+import Panic      hiding (showException)
 import Config
 import StaticFlags
 import Linker
 import Util
 
+-- The debugger
+import Debugger 
+import HscTypes
+import Id
+import Var       ( globaliseId )
+import IdInfo
+import NameEnv
+import RdrName
+import Module
+import Type
+import TcType
+
 #ifndef mingw32_HOST_OS
 import System.Posix
 #if __GLASGOW_HASKELL__ > 504
@@ -73,9 +73,7 @@ import System.Console.Readline as Readline
 import Control.Exception as Exception
 -- import Control.Concurrent
 
-import Numeric
 import Data.List
-import Data.Int                ( Int64 )
 import Data.Maybe      ( isJust, isNothing, fromMaybe, catMaybes )
 import System.Cmd
 import System.Environment
@@ -84,16 +82,24 @@ import System.Directory
 import System.IO
 import System.IO.Error as IO
 import Data.Char
+import Data.Dynamic
+import Data.Array
 import Control.Monad as Monad
-import Foreign.StablePtr       ( newStablePtr )
+import Foreign.StablePtr       ( StablePtr, newStablePtr, deRefStablePtr, freeStablePtr )
 
 import GHC.Exts                ( unsafeCoerce# )
-import GHC.IOBase      ( IOErrorType(InvalidArgument) )
+import GHC.IOBase      ( IOErrorType(InvalidArgument), IO(IO) )
 
-import Data.IORef      ( IORef, newIORef, readIORef, writeIORef )
+import Data.IORef      ( IORef, readIORef, writeIORef )
 
 import System.Posix.Internals ( setNonBlockingFD )
 
+-- these are needed by the new ghci debugger
+import ByteCodeLink (HValue)
+import ByteCodeInstr (BreakInfo (..))
+import BreakArray
+import TickTree 
+
 -----------------------------------------------------------------------------
 
 ghciWelcomeMsg =
@@ -110,35 +116,50 @@ GLOBAL_VAR(commands, builtin_commands, [Command])
 
 builtin_commands :: [Command]
 builtin_commands = [
-  ("add",      keepGoingPaths addModule,       False, completeFilename),
+       -- Hugs users are accustomed to :e, so make sure it doesn't overlap
+  ("?",                keepGoing help,                 False, completeNone),
+  ("add",      tlC$ keepGoingPaths addModule,  False, completeFilename),
+  ("break",     breakCmd, False, completeNone),   
   ("browse",    keepGoing browseCmd,           False, completeModule),
-  ("cd",       keepGoing changeDirectory,      False, completeFilename),
+  ("cd",       tlC$ keepGoing changeDirectory, False, completeFilename),
+  ("check",    keepGoing checkModule,          False, completeHomeModule),
+  ("continue",  continueCmd, False, completeNone),
+  ("ctags",    keepGoing createCTagsFileCmd,   False, completeFilename),
   ("def",      keepGoing defineMacro,          False, completeIdentifier),
+  ("delete",    deleteCmd, False, completeNone),   
   ("e",        keepGoing editFile,             False, completeFilename),
-       -- Hugs users are accustomed to :e, so make sure it doesn't overlap
   ("edit",     keepGoing editFile,             False, completeFilename),
+  ("etags",    keepGoing createETagsFileCmd,   False, completeFilename),
+  ("force",     keepGoing (pprintClosureCommand False True), False, completeIdentifier),
   ("help",     keepGoing help,                 False, completeNone),
-  ("?",                keepGoing help,                 False, completeNone),
   ("info",      keepGoing info,                        False, completeIdentifier),
-  ("load",     keepGoingPaths loadModule_,     False, completeHomeModuleOrFile),
+  ("kind",     keepGoing kindOfType,           False, completeIdentifier),
+  ("load",     tlC$ keepGoingPaths loadModule_,False, completeHomeModuleOrFile),
   ("module",   keepGoing setContext,           False, completeModule),
-  ("main",     keepGoing runMain,              False, completeIdentifier),
-  ("reload",   keepGoing reloadModule,         False, completeNone),
-  ("check",    keepGoing checkModule,          False, completeHomeModule),
+  ("main",     tlC$ keepGoing runMain,         False, completeIdentifier),
+  ("print",     keepGoing (pprintClosureCommand True False), False, completeIdentifier),
+  ("quit",     quit,                           False, completeNone),
+  ("reload",   tlC$ keepGoing reloadModule,    False, completeNone),
   ("set",      keepGoing setCmd,               True,  completeSetOptions),
   ("show",     keepGoing showCmd,              False, completeNone),
-  ("etags",    keepGoing createETagsFileCmd,   False, completeFilename),
-  ("ctags",    keepGoing createCTagsFileCmd,   False, completeFilename),
+  ("sprint",    keepGoing (pprintClosureCommand False False),False, completeIdentifier),
+  ("step",      stepCmd, False, completeNone), 
   ("type",     keepGoing typeOfExpr,           False, completeIdentifier),
-  ("kind",     keepGoing kindOfType,           False, completeIdentifier),
-  ("unset",    keepGoing unsetOptions,         True,  completeSetOptions),
   ("undef",     keepGoing undefineMacro,       False, completeMacro),
-  ("quit",     quit,                           False, completeNone)
+  ("unset",    keepGoing unsetOptions,         True,  completeSetOptions)
   ]
 
 keepGoing :: (String -> GHCi ()) -> (String -> GHCi Bool)
 keepGoing a str = a str >> return False
 
+-- tlC: Top Level Command, not allowed in inferior sessions
+tlC ::  (String -> GHCi Bool) -> (String -> GHCi Bool)
+tlC a str = do 
+    top_level <- isTopLevel
+    if not top_level
+       then throwDyn (CmdLineError "Command only allowed at Top Level")
+       else a str
+
 keepGoingPaths :: ([FilePath] -> GHCi ()) -> (String -> GHCi Bool)
 keepGoingPaths a str = a (toArgs str) >> return False
 
@@ -157,6 +178,8 @@ helpText =
  "   :edit                       edit last module\n" ++
  "   :help, :?                   display this list of commands\n" ++
  "   :info [<name> ...]          display information about the given names\n" ++
+ "   :print [<name> ...]         prints a value without forcing its computation\n" ++
+ "   :sprint [<name> ...]        simplified version of :print\n" ++
  "   :load <filename> ...        load module(s) and their dependents\n" ++
  "   :module [+/-] [*]<mod> ...  set the context for expression evaluation\n" ++
  "   :main [<arguments> ...]     run the main function with the given arguments\n" ++
@@ -186,73 +209,9 @@ helpText =
  "    +s            print timing/memory stats after each evaluation\n" ++
  "    +t            print type after evaluation\n" ++
  "    -<flags>      most GHC command line flags can also be set here\n" ++
- "                         (eg. -v2, -fglasgow-exts, etc.)\n"
-
-
-#if defined(GHCI) && defined(BREAKPOINT)
-globaliseAndTidy :: Id -> Id
-globaliseAndTidy id
--- Give the Id a Global Name, and tidy its type
-  = Id.setIdType (globaliseId VanillaGlobal id) tidy_type
-  where
-    tidy_type = tidyTopType (idType id)
-
-
-printScopeMsg :: Session -> String -> [Id] -> IO ()
-printScopeMsg session location ids
-    = GHC.getPrintUnqual session >>= \unqual ->
-      printForUser stdout unqual $
-        text "Local bindings in scope:" $$
-        nest 2 (pprWithCommas showId ids)
-    where showId id = ppr (idName id) <+> dcolon <+> ppr (idType id)
-
-jumpCondFunction :: Session -> Int -> [HValue] -> String -> Bool -> b -> b
-jumpCondFunction session ptr hValues location True b = b
-jumpCondFunction session ptr hValues location False b
-    = jumpFunction session ptr hValues location b
-
-jumpFunction :: Session -> Int -> [HValue] -> String -> b -> b
-jumpFunction session@(Session ref) (I# idsPtr) hValues location b
-    = unsafePerformIO $
-      do ids <- deRefStablePtr (castPtrToStablePtr (Ptr (int2Addr# idsPtr)))
-         let names = map idName ids
-         ASSERT (length names == length hValues) return ()
-         printScopeMsg session location ids
-         hsc_env <- readIORef ref
-
-         let ictxt = hsc_IC hsc_env
-             global_ids = map globaliseAndTidy ids
-             rn_env   = ic_rn_local_env ictxt
-             type_env = ic_type_env ictxt
-             bound_names = map idName global_ids
-             new_rn_env  = extendLocalRdrEnv rn_env bound_names
-               -- Remove any shadowed bindings from the type_env;
-               -- they are inaccessible but might, I suppose, cause 
-               -- a space leak if we leave them there
-             shadowed = [ n | name <- bound_names,
-                          let rdr_name = mkRdrUnqual (nameOccName name),
-                          Just n <- [lookupLocalRdrEnv rn_env rdr_name] ]
-             filtered_type_env = delListFromNameEnv type_env shadowed
-             new_type_env = extendTypeEnvWithIds filtered_type_env global_ids
-             new_ic = ictxt { ic_rn_local_env = new_rn_env, 
-                             ic_type_env     = new_type_env }
-         writeIORef ref (hsc_env { hsc_IC = new_ic })
-         is_tty <- hIsTerminalDevice stdin
-         prel_mod <- GHC.findModule session prel_name Nothing
-        default_editor <- findEditor
-         withExtendedLinkEnv (zip names hValues) $
-           startGHCi (interactiveLoop is_tty True)
-                     GHCiState{ progname = "<interactive>",
-                                args = [],
-                                prompt = location++"> ",
-                               editor = default_editor,
-                                session = session,
-                                options = [],
-                                prelude =  prel_mod }
-         writeIORef ref hsc_env
-         putStrLn $ "Returning to normal execution..."
-         return b
-#endif
+ "                         (eg. -v2, -fglasgow-exts, etc.)\n" ++
+ "\n" 
+-- Todo: add help for breakpoint commands here
 
 findEditor = do
   getEnv "EDITOR" 
@@ -266,11 +225,6 @@ findEditor = do
 
 interactiveUI :: Session -> [(FilePath, Maybe Phase)] -> Maybe String -> IO ()
 interactiveUI session srcs maybe_expr = do
-#if defined(GHCI) && defined(BREAKPOINT)
-   initDynLinker =<< GHC.getSessionDynFlags session
-   extendLinkEnv [(breakpointJumpName,unsafeCoerce# (jumpFunction session))
-                 ,(breakpointCondJumpName,unsafeCoerce# (jumpCondFunction session))]
-#endif
    -- HACK! If we happen to get into an infinite loop (eg the user
    -- types 'let x=x in x' at the prompt), then the thread will block
    -- on a blackhole, and become unreachable during GC.  The GC will
@@ -298,7 +252,7 @@ interactiveUI session srcs maybe_expr = do
        hSetBuffering stdin NoBuffering
 
        -- initial context is just the Prelude
-   prel_mod <- GHC.findModule session prel_name Nothing
+   prel_mod <- GHC.findModule session prel_name (Just basePackageId)
    GHC.setContext session [] [prel_mod]
 
 #ifdef USE_READLINE
@@ -324,7 +278,11 @@ interactiveUI session srcs maybe_expr = do
                   editor = default_editor,
                   session = session,
                   options = [],
-                   prelude = prel_mod }
+                   prelude = prel_mod,
+                  topLevel = True,
+                   resume = [],
+                   breaks = emptyActiveBreakPoints
+                 }
 
 #ifdef USE_READLINE
    Readline.resetTerminal Nothing
@@ -563,10 +521,84 @@ runStmt stmt
       session <- getSession
       result <- io $ withProgName (progname st) $ withArgs (args st) $
                     GHC.runStmt session stmt
-      case result of
-       GHC.RunFailed      -> return Nothing
-       GHC.RunException e -> throw e  -- this is caught by runCommand(Eval)
-       GHC.RunOk names    -> return (Just names)
+      switchOnRunResult result
+
+switchOnRunResult :: GHC.RunResult -> GHCi (Maybe [Name])
+switchOnRunResult GHC.RunFailed = return Nothing
+switchOnRunResult (GHC.RunException e) = throw e
+switchOnRunResult (GHC.RunOk names) = return $ Just names
+switchOnRunResult (GHC.RunBreak apStack _threadId info resume) = do  -- Todo: we don't use threadID, perhaps delete?
+   session <- getSession
+   Just mod_info <- io $ GHC.getModuleInfo session (breakInfo_module info) 
+   let modBreaks  = GHC.modInfoModBreaks mod_info
+   let ticks      = modBreaks_ticks modBreaks
+   io $ displayBreakInfo session ticks info
+   io $ extendEnvironment session apStack (breakInfo_vars info) 
+   pushResume resume
+   return Nothing
+
+displayBreakInfo :: Session -> Array Int SrcSpan -> BreakInfo -> IO ()
+displayBreakInfo session ticks info = do
+   unqual <- GHC.getPrintUnqual session
+   let location = ticks ! breakInfo_number info
+   printForUser stdout unqual $
+      ptext SLIT("Stopped at") <+> ppr location $$ localsMsg 
+   where
+   vars = map fst $ breakInfo_vars info 
+   localsMsg = if null vars
+                  then text "No locals in scope."
+                  else text "Locals:" <+> (pprWithCommas showId vars)
+   showId id = ppr (idName id) <+> dcolon <+> ppr (idType id) 
+
+-- Todo: turn this into a primop, and provide special version(s) for unboxed things
+foreign import ccall "rts_getApStackVal" getApStackVal :: StablePtr a -> Int -> IO (StablePtr b)
+
+getIdValFromApStack :: a -> (Id, Int) -> IO (Id, HValue)
+getIdValFromApStack apStack (identifier, stackDepth) = do
+   -- ToDo: check the type of the identifer and decide whether it is unboxed or not
+   apSptr <- newStablePtr apStack
+   resultSptr <- getApStackVal apSptr (stackDepth - 1)
+   result <- deRefStablePtr resultSptr
+   freeStablePtr apSptr
+   freeStablePtr resultSptr 
+   return (identifier, unsafeCoerce# result)
+
+extendEnvironment :: Session -> a -> [(Id, Int)] -> IO ()
+extendEnvironment s@(Session ref) apStack idsOffsets = do
+   idsVals <- mapM (getIdValFromApStack apStack) idsOffsets 
+   let (ids, hValues) = unzip idsVals 
+   let names = map idName ids
+   let global_ids = map globaliseAndTidy ids
+   typed_ids  <- mapM instantiateIdType global_ids
+   hsc_env <- readIORef ref
+   let ictxt = hsc_IC hsc_env
+       rn_env   = ic_rn_local_env ictxt
+       type_env = ic_type_env ictxt
+       bound_names = map idName typed_ids
+       new_rn_env  = extendLocalRdrEnv rn_env bound_names
+       -- Remove any shadowed bindings from the type_env;
+       -- they are inaccessible but might, I suppose, cause 
+       -- a space leak if we leave them there
+       shadowed = [ n | name <- bound_names,
+                    let rdr_name = mkRdrUnqual (nameOccName name),
+                    Just n <- [lookupLocalRdrEnv rn_env rdr_name] ]
+       filtered_type_env = delListFromNameEnv type_env shadowed
+       new_type_env = extendTypeEnvWithIds filtered_type_env (typed_ids)
+       new_ic = ictxt { ic_rn_local_env = new_rn_env, 
+                       ic_type_env     = new_type_env }
+   writeIORef ref (hsc_env { hsc_IC = new_ic })
+   extendLinkEnv (zip names hValues) -- ToDo: we must remember to restore the old env after we finish a breakpoint
+   where
+   globaliseAndTidy :: Id -> Id
+   globaliseAndTidy id
+      = let tidied_type = tidyTopType$ idType id
+        in setIdType (globaliseId VanillaGlobal id) tidied_type
+
+   -- | Instantiate the tyVars with GHC.Base.Unknown
+   instantiateIdType :: Id -> IO Id
+   instantiateIdType id = do
+      instantiatedType <- instantiateTyVarsToUnknown s (idType id)
+      return$ setIdType id instantiatedType
 
 -- possibly print the type and revert CAFs after evaluating an expression
 finishEvalExpr mb_names
@@ -813,10 +845,6 @@ afterLoad ok session = do
   graph' <- filterM (io . GHC.isLoaded session . GHC.ms_mod_name) graph
   setContextAfterLoad session graph'
   modulesLoadedMsg ok (map GHC.ms_mod_name graph')
-#if defined(GHCI) && defined(BREAKPOINT)
-  io (extendLinkEnv [(breakpointJumpName,unsafeCoerce# (jumpFunction session))
-                    ,(breakpointCondJumpName,unsafeCoerce# (jumpCondFunction session))])
-#endif
 
 setContextAfterLoad session [] = do
   prel_mod <- getPrelude
@@ -884,7 +912,7 @@ kindOfType str
          Nothing    -> return ()
          Just ty    -> do tystr <- showForUser (ppr ty)
                           io (putStrLn (str ++ " :: " ++ tystr))
-
+          
 quit :: String -> GHCi Bool
 quit _ = return True
 
@@ -1248,6 +1276,7 @@ showCmd str =
        ["modules" ] -> showModules
        ["bindings"] -> showBindings
        ["linker"]   -> io showLinkerState
+        ["breaks"] -> showBkptTable
        _ -> throwDyn (CmdLineError "syntax:  :show [modules|bindings]")
 
 showModules = do
@@ -1278,6 +1307,12 @@ cleanType ty = do
        then return ty
        else return $! GHC.dropForAlls ty
 
+showBkptTable :: GHCi ()
+showBkptTable = do
+   activeBreaks <- getActiveBreakPoints 
+   str <- showForUser $ ppr activeBreaks 
+   io $ putStrLn str
+
 -- -----------------------------------------------------------------------------
 -- Completion
 
@@ -1372,7 +1407,7 @@ wrapCompleter fun w =  do
 getCommonPrefix :: [String] -> String
 getCommonPrefix [] = ""
 getCommonPrefix (s:ss) = foldl common s ss
-  where common s "" = s
+  where common s "" = ""
        common "" s = ""
        common (c:cs) (d:ds)
           | c == d = c : common cs ds
@@ -1392,8 +1427,56 @@ completeHomeModule = completeNone
 completeSetOptions = completeNone
 completeFilename   = completeNone
 completeHomeModuleOrFile=completeNone
+completeBkpt       = completeNone
 #endif
 
+-- ---------------------------------------------------------------------------
+-- User code exception handling
+
+-- This is the exception handler for exceptions generated by the
+-- user's code and exceptions coming from children sessions; 
+-- it normally just prints out the exception.  The
+-- handler must be recursive, in case showing the exception causes
+-- more exceptions to be raised.
+--
+-- Bugfix: if the user closed stdout or stderr, the flushing will fail,
+-- raising another exception.  We therefore don't put the recursive
+-- handler arond the flushing operation, so if stderr is closed
+-- GHCi will just die gracefully rather than going into an infinite loop.
+handler :: Exception -> GHCi Bool
+
+handler exception = do
+  flushInterpBuffers
+  io installSignalHandlers
+  ghciHandle handler (showException exception >> return False)
+
+showException (DynException dyn) =
+  case fromDynamic dyn of
+    Nothing               -> io (putStrLn ("*** Exception: (unknown)"))
+    Just Interrupted      -> io (putStrLn "Interrupted.")
+    Just (CmdLineError s) -> io (putStrLn s)    -- omit the location for CmdLineError
+    Just ph@PhaseFailed{} -> io (putStrLn (showGhcException ph "")) -- ditto
+    Just other_ghc_ex     -> io (print other_ghc_ex)
+
+showException other_exception
+  = io (putStrLn ("*** Exception: " ++ show other_exception))
+
+-----------------------------------------------------------------------------
+-- recursive exception handlers
+
+-- Don't forget to unblock async exceptions in the handler, or if we're
+-- in an exception loop (eg. let a = error a in a) the ^C exception
+-- may never be delivered.  Thanks to Marcin for pointing out the bug.
+
+ghciHandle :: (Exception -> GHCi a) -> GHCi a -> GHCi a
+ghciHandle h (GHCi m) = GHCi $ \s -> 
+   Exception.catch (m s) 
+       (\e -> unGHCi (ghciUnblock (h e)) s)
+
+ghciUnblock :: GHCi a -> GHCi a
+ghciUnblock (GHCi a) = GHCi $ \s -> Exception.unblock (a s)
+
+
 -- ----------------------------------------------------------------------------
 -- Utils
 
@@ -1429,3 +1512,164 @@ setUpConsole = do
        setConsoleOutputCP 28591 -- ISO Latin-1
 #endif
        return ()
+
+-- commands for debugger
+foreign import ccall "rts_setStepFlag" setStepFlag :: IO () 
+
+stepCmd :: String -> GHCi Bool
+stepCmd [] = doContinue setStepFlag 
+stepCmd expression = do
+   io $ setStepFlag
+   runCommand expression
+
+continueCmd :: String -> GHCi Bool
+continueCmd [] = doContinue $ return () 
+continueCmd other = do
+   io $ putStrLn "The continue command accepts no arguments."
+   return False
+
+doContinue :: IO () -> GHCi Bool
+doContinue actionBeforeCont = do 
+   resumeAction <- getResume
+   popResume
+   case resumeAction of
+      Nothing -> do 
+         io $ putStrLn "There is no computation running."
+         return False
+      Just action -> do
+         io $ actionBeforeCont
+         runResult <- io action
+         names <- switchOnRunResult runResult
+         finishEvalExpr names
+         return False 
+
+deleteCmd :: String -> GHCi Bool
+deleteCmd argLine = do
+   deleteSwitch $ words argLine
+   return False
+   where
+   deleteSwitch :: [String] -> GHCi ()
+   deleteSwitch [] = 
+      io $ putStrLn "The delete command requires at least one argument."
+   -- delete all break points
+   deleteSwitch ("*":_rest) = clearActiveBreakPoints
+   deleteSwitch idents = do
+      mapM_ deleteOneBreak idents 
+      where
+      deleteOneBreak :: String -> GHCi ()
+      deleteOneBreak str
+         | all isDigit str = deleteBreak (read str)
+         | otherwise = return ()
+
+-- handle the "break" command
+breakCmd :: String -> GHCi Bool
+breakCmd argLine = do
+   session <- getSession
+   breakSwitch session $ words argLine
+
+breakSwitch :: Session -> [String] -> GHCi Bool
+breakSwitch _session [] = do
+   io $ putStrLn "The break command requires at least one argument."
+   return False
+breakSwitch session args@(arg1:rest) 
+   | looksLikeModule arg1 = do
+        mod     <- lookupModule session arg1 
+        breakByModule mod rest
+        return False
+   | otherwise = do
+        (toplevel, _) <- io $ GHC.getContext session 
+        case toplevel of
+           (mod : _) -> breakByModule mod args 
+           [] -> do 
+              io $ putStrLn "Cannot find default module for breakpoint." 
+              io $ putStrLn "Perhaps no modules are loaded for debugging?"
+        return False
+   where
+   -- Todo there may be a nicer way to test this
+   looksLikeModule :: String -> Bool
+   looksLikeModule []    = False
+   looksLikeModule (x:_) = isUpper x
+
+breakByModule :: Module -> [String] -> GHCi () 
+breakByModule mod args@(arg1:rest)
+   | all isDigit arg1 = do  -- looks like a line number
+        breakByModuleLine mod (read arg1) rest
+   | looksLikeVar arg1 = do
+        -- break by a function definition
+        io $ putStrLn "Break by function definition not implemented."
+   | otherwise = io $ putStrLn "Invalid arguments to break command."
+   where
+   -- Todo there may be a nicer way to test this
+   looksLikeVar :: String -> Bool
+   looksLikeVar [] = False
+   looksLikeVar (x:_) = isLower x || x `elem` "~!@#$%^&*-+"
+
+breakByModuleLine :: Module -> Int -> [String] -> GHCi ()
+breakByModuleLine mod line args
+   | [] <- args = findBreakAndSet mod $ lookupTickTreeLine line
+   | [col] <- args, all isDigit col =
+        findBreakAndSet mod $ lookupTickTreeCoord (line, read col)
+   | otherwise = io $ putStrLn "Invalid arguments to break command."
+        
+findBreakAndSet :: Module -> (TickTree -> Maybe (Int, SrcSpan)) -> GHCi ()
+findBreakAndSet mod lookupTickTree = do 
+   (breakArray, ticks) <- getModBreak mod 
+   let tickTree   = tickTreeFromList (assocs ticks)
+   case lookupTickTree tickTree of 
+      Nothing  -> io $ putStrLn $ "No breakpoints found at that location."
+      Just (tick, span) -> do
+         success <- io $ setBreakFlag True breakArray tick 
+         session <- getSession
+         unqual  <- io $ GHC.getPrintUnqual session
+         if success 
+            then do
+               (alreadySet, nm) <- 
+                     recordBreak $ BreakLocation
+                             { breakModule = mod
+                             , breakLoc = span
+                             , breakTick = tick
+                             }
+               io $ printForUser stdout unqual $
+                  text "Breakpoint " <> ppr nm <>
+                  if alreadySet 
+                     then text " was already set at " <> ppr span
+                     else text " activated at " <> ppr span
+            else do
+            str <- showForUser $ text "Breakpoint could not be activated at" 
+                                 <+> ppr span
+            io $ putStrLn str
+
+getModBreak :: Module -> GHCi (BreakArray, Array Int SrcSpan)
+getModBreak mod = do
+   session <- getSession
+   Just mod_info <- io $ GHC.getModuleInfo session mod
+   let modBreaks  = GHC.modInfoModBreaks mod_info
+   let array      = modBreaks_array modBreaks
+   let ticks      = modBreaks_ticks modBreaks
+   return (array, ticks)
+
+lookupModule :: Session -> String -> GHCi Module
+lookupModule session modName
+   = io (GHC.findModule session (GHC.mkModuleName modName) Nothing)
+
+setBreakFlag :: Bool -> BreakArray -> Int -> IO Bool 
+setBreakFlag toggle array index
+   | toggle    = setBreakOn array index 
+   | otherwise = setBreakOff array index
+
+
+{- these should probably go to the GHC API at some point -}
+enableBreakPoint  :: Session -> Module -> Int -> IO ()
+enableBreakPoint session mod index = return ()
+
+disableBreakPoint :: Session -> Module -> Int -> IO ()
+disableBreakPoint session mod index = return ()
+
+activeBreakPoints :: Session -> IO [(Module,Int)]
+activeBreakPoints session = return []
+
+enableSingleStep  :: Session -> IO ()
+enableSingleStep session = return ()
+
+disableSingleStep :: Session -> IO ()
+disableSingleStep session = return ()