X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FInteractiveUI.hs;h=1ab604c6cdf76d3e7c39b322032ba7a9a6b60f94;hb=ed1f16f4bde6ffcbb953ebeea0db1bc3802d3af3;hp=b794436b952d1a96464d6cb1424e4c1e419218da;hpb=cdce647711c0f46f5799b24de087622cb77e647f;p=ghc-hetmet.git

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index b794436..1ab604c 100644
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -18,13 +18,16 @@ import GhciMonad
 -- The GHC interface
 import qualified GHC
 import GHC              ( Session, LoadHowMuch(..), Target(..),  TargetId(..),
-                          Type, Module, ModuleName, TyThing(..), Phase )
+                          Type, Module, ModuleName, TyThing(..), Phase,
+                          BreakIndex )
+import Debugger
 import DynFlags
 import Packages
 import PackageConfig
 import UniqFM
 import PprTyThing
-import Outputable
+import Outputable       hiding (printForUser)
+import Module           -- for ModuleEnv
 
 -- for createtags
 import Name
@@ -35,23 +38,12 @@ import SrcLoc
 import Digraph
 import BasicTypes hiding (isTopLevel)
 import Panic      hiding (showException)
+import FastString       ( unpackFS )
 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,8 +65,9 @@ import System.Console.Readline as Readline
 import Control.Exception as Exception
 -- import Control.Concurrent
 
+import qualified Data.ByteString.Char8 as BS
 import Data.List
-import Data.Maybe	( isJust, isNothing, fromMaybe, catMaybes )
+import Data.Maybe
 import System.Cmd
 import System.Environment
 import System.Exit	( exitWith, ExitCode(..) )
@@ -85,21 +78,15 @@ import Data.Char
 import Data.Dynamic
 import Data.Array
 import Control.Monad as Monad
-import Foreign.StablePtr	( StablePtr, newStablePtr, deRefStablePtr, freeStablePtr )
 
+import Foreign.StablePtr	( newStablePtr )
 import GHC.Exts		( unsafeCoerce# )
-import GHC.IOBase	( IOErrorType(InvalidArgument), IO(IO) )
+import GHC.IOBase	( IOErrorType(InvalidArgument) )
 
 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 =
@@ -118,15 +105,15 @@ builtin_commands :: [Command]
 builtin_commands = [
 	-- 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),   
+  ("add",	keepGoingPaths addModule,	False, completeFilename),
+  ("break",     keepGoing breakCmd,             False, completeIdentifier),
   ("browse",    keepGoing browseCmd,		False, completeModule),
-  ("cd",    	tlC$ keepGoing changeDirectory,	False, completeFilename),
+  ("cd",    	keepGoing changeDirectory,	False, completeFilename),
   ("check",	keepGoing checkModule,		False, completeHomeModule),
-  ("continue",  continueCmd, False, completeNone),
+  ("continue",  continueCmd,                    False, completeNone),
   ("ctags",	keepGoing createCTagsFileCmd, 	False, completeFilename),
   ("def",	keepGoing defineMacro,		False, completeIdentifier),
-  ("delete",    deleteCmd, False, completeNone),   
+  ("delete",    keepGoing deleteCmd,            False, completeNone),
   ("e", 	keepGoing editFile,		False, completeFilename),
   ("edit",	keepGoing editFile,		False, completeFilename),
   ("etags",	keepGoing createETagsFileCmd,	False, completeFilename),
@@ -134,16 +121,17 @@ builtin_commands = [
   ("help",	keepGoing help,			False, completeNone),
   ("info",      keepGoing info,			False, completeIdentifier),
   ("kind",	keepGoing kindOfType,		False, completeIdentifier),
-  ("load",	tlC$ keepGoingPaths loadModule_,False, completeHomeModuleOrFile),
+  ("load",	keepGoingPaths loadModule_,     False, completeHomeModuleOrFile),
+  ("list",	keepGoing listCmd,              False, completeNone),
   ("module",	keepGoing setContext,		False, completeModule),
-  ("main",	tlC$ keepGoing runMain,		False, completeIdentifier),
+  ("main",	keepGoing runMain,		False, completeIdentifier),
   ("print",     keepGoing (pprintClosureCommand True False), False, completeIdentifier),
   ("quit",	quit,				False, completeNone),
-  ("reload", 	tlC$ keepGoing reloadModule,  	False, completeNone),
+  ("reload", 	keepGoing reloadModule,  	False, completeNone),
   ("set",	keepGoing setCmd,		True,  completeSetOptions),
   ("show",	keepGoing showCmd,		False, completeNone),
   ("sprint",    keepGoing (pprintClosureCommand False False),False, completeIdentifier),
-  ("step",      stepCmd, False, completeNone), 
+  ("step",      stepCmd,                        False, completeIdentifier), 
   ("type",	keepGoing typeOfExpr,		False, completeIdentifier),
   ("undef",     keepGoing undefineMacro,	False, completeMacro),
   ("unset",	keepGoing unsetOptions,		True,  completeSetOptions)
@@ -152,37 +140,37 @@ builtin_commands = [
 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
 
 shortHelpText = "use :? for help.\n"
 
--- NOTE: spaces at the end of each line to workaround CPP/string gap bug.
 helpText =
  " Commands available from the prompt:\n" ++
  "\n" ++
  "   <stmt>                      evaluate/run <stmt>\n" ++
  "   :add <filename> ...         add module(s) to the current target set\n" ++
+ "   :break [<mod>] <l> [<col>]  set a breakpoint at the specified location\n" ++
+ "   :break <name>               set a breakpoint on the specified function\n" ++
  "   :browse [*]<module>         display the names defined by <module>\n" ++
  "   :cd <dir>                   change directory to <dir>\n" ++
+ "   :continue                   resume after a breakpoint\n" ++
+ "   :ctags [<file>]             create tags file for Vi (default: \"tags\")\n" ++
  "   :def <cmd> <expr>           define a command :<cmd>\n" ++
+ "   :delete <number>            delete the specified breakpoint\n" ++
+ "   :delete *                   delete all breakpoints\n" ++
  "   :edit <file>                edit file\n" ++
  "   :edit                       edit last module\n" ++
+ "   :etags [<file>]             create tags file for Emacs (default: \"TAGS\")\n" ++
+-- "   :force <expr>               print <expr>, forcing unevaluated parts\n" ++
  "   :help, :?                   display this list of commands\n" ++
  "   :info [<name> ...]          display information about the given names\n" ++
- "   :print [<name> ...]         prints a value without forcing its computation\n" ++
- "   :sprint [<name> ...]        simplified version of :print\n" ++
+ "   :kind <type>                show the kind of <type>\n" ++
  "   :load <filename> ...        load module(s) and their dependents\n" ++
  "   :module [+/-] [*]<mod> ...  set the context for expression evaluation\n" ++
  "   :main [<arguments> ...]     run the main function with the given arguments\n" ++
+ "   :print [<name> ...]         prints a value without forcing its computation\n" ++
+ "   :quit                       exit GHCi\n" ++
  "   :reload                     reload the current module set\n" ++
  "\n" ++
  "   :set <option> ...           set options\n" ++
@@ -190,17 +178,19 @@ helpText =
  "   :set prog <progname>        set the value returned by System.getProgName\n" ++
  "   :set prompt <prompt>        set the prompt used in GHCi\n" ++
  "   :set editor <cmd>           set the command used for :edit\n" ++
+ "   :set stop <cmd>             set the command to run when a breakpoint is hit\n" ++
  "\n" ++
+ "   :show breaks                show active breakpoints\n" ++
+ "   :show context               show the breakpoint context\n" ++
  "   :show modules               show the currently loaded modules\n" ++
  "   :show bindings              show the current bindings made at the prompt\n" ++
  "\n" ++
- "   :ctags [<file>]             create tags file for Vi (default: \"tags\")\n" ++
- "   :etags [<file>]             create tags file for Emacs (default: \"TAGS\")\n" ++
+ "   :sprint [<name> ...]        simplifed version of :print\n" ++
+ "   :step                       single-step after stopping at a breakpoint\n"++
+ "   :step <expr>                single-step into <expr>\n"++
  "   :type <expr>                show the type of <expr>\n" ++
- "   :kind <type>                show the kind of <type>\n" ++
  "   :undef <cmd>                undefine user-defined command :<cmd>\n" ++
  "   :unset <option> ...         unset options\n" ++
- "   :quit                       exit GHCi\n" ++
  "   :!<command>                 run the shell command <command>\n" ++
  "\n" ++
  " Options for ':set' and ':unset':\n" ++
@@ -275,13 +265,14 @@ interactiveUI session srcs maybe_expr = do
 	GHCiState{ progname = "<interactive>",
 		   args = [],
                    prompt = "%s> ",
+                   stop = "",
 		   editor = default_editor,
 		   session = session,
 		   options = [],
                    prelude = prel_mod,
-		   topLevel = True,
                    resume = [],
-                   breaks = emptyActiveBreakPoints
+                   breaks = emptyActiveBreakPoints,
+                   tickarrays = emptyModuleEnv
                  }
 
 #ifdef USE_READLINE
@@ -462,7 +453,7 @@ mkPrompt toplevs exports prompt
     
         perc_s = hsep (map (\m -> char '*' <> ppr (GHC.moduleName m)) toplevs) <+>
                  hsep (map (ppr . GHC.moduleName) exports)
-             
+
 
 #ifdef USE_READLINE
 readlineLoop :: GHCi ()
@@ -511,11 +502,12 @@ runCommandEval c = ghciHandle handleEval (doCommand c)
 	    case nms of 
 		Nothing -> io (exitWith (ExitFailure 1))
 		  -- failure to run the command causes exit(1) for ghc -e.
-		_       -> finishEvalExpr nms
+		_       -> do finishEvalExpr nms
+                              return True
 
-runStmt :: String -> GHCi (Maybe [Name])
+runStmt :: String -> GHCi (Maybe (Bool,[Name]))
 runStmt stmt
- | null (filter (not.isSpace) stmt) = return (Just [])
+ | null (filter (not.isSpace) stmt) = return (Just (False,[]))
  | otherwise
  = do st <- getGHCiState
       session <- getSession
@@ -523,96 +515,42 @@ runStmt stmt
 	     	     GHC.runStmt session stmt
       switchOnRunResult result
 
-switchOnRunResult :: GHC.RunResult -> GHCi (Maybe [Name])
+switchOnRunResult :: GHC.RunResult -> GHCi (Maybe (Bool,[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?
+switchOnRunResult (GHC.RunOk names) = return $ Just (False,names)
+switchOnRunResult (GHC.RunBreak threadId names info resume) = do
    session <- getSession
-   Just mod_info <- io $ GHC.getModuleInfo session (breakInfo_module info) 
+   Just mod_info <- io $ GHC.getModuleInfo session (GHC.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
+   let ticks      = GHC.modBreaks_locs modBreaks
 
-   -- | Instantiate the tyVars with GHC.Base.Unknown
-   instantiateIdType :: Id -> IO Id
-   instantiateIdType id = do
-      instantiatedType <- instantiateTyVarsToUnknown s (idType id)
-      return$ setIdType id instantiatedType
+   -- display information about the breakpoint
+   let location = ticks ! GHC.breakInfo_number info
+   printForUser $ ptext SLIT("Stopped at") <+> ppr location
+
+   pushResume location threadId resume
+
+   -- run the command set with ":set stop <cmd>"
+   st <- getGHCiState
+   runCommand (stop st)
+
+   return (Just (True,names))
 
 -- possibly print the type and revert CAFs after evaluating an expression
 finishEvalExpr mb_names
- = do b <- isOptionSet ShowType
+ = do show_types <- isOptionSet ShowType
       session <- getSession
       case mb_names of
 	Nothing    -> return ()      
-	Just names -> when b (mapM_ (showTypeOfName session) names)
+	Just (is_break,names) -> 
+                when (is_break || show_types) $
+                      mapM_ (showTypeOfName session) names
 
       flushInterpBuffers
       io installSignalHandlers
       b <- isOptionSet RevertCAFs
       io (when b revertCAFs)
-      return True
 
 showTypeOfName :: Session -> Name -> GHCi ()
 showTypeOfName session n
@@ -841,6 +779,9 @@ reloadModule m = do
 
 afterLoad ok session = do
   io (revertCAFs)  -- always revert CAFs on load.
+  discardResumeContext
+  discardTickArrays
+  discardActiveBreakPoints
   graph <- io (GHC.getModuleGraph session)
   graph' <- filterM (io . GHC.isLoaded session . GHC.ms_mod_name) graph
   setContextAfterLoad session graph'
@@ -901,8 +842,7 @@ typeOfExpr str
        case maybe_ty of
 	  Nothing -> return ()
 	  Just ty -> do ty' <- cleanType ty
-			tystr <- showForUser (ppr ty')
-		        io (putStrLn (str ++ " :: " ++ tystr))
+                        printForUser $ text str <> text " :: " <> ppr ty'
 
 kindOfType :: String -> GHCi ()
 kindOfType str 
@@ -910,8 +850,7 @@ kindOfType str
        maybe_ty <- io (GHC.typeKind cms str)
        case maybe_ty of
 	  Nothing    -> return ()
-	  Just ty    -> do tystr <- showForUser (ppr ty)
-		           io (putStrLn (str ++ " :: " ++ tystr))
+	  Just ty    -> printForUser $ text str <> text " :: " <> ppr ty
           
 quit :: String -> GHCi Bool
 quit _ = return True
@@ -1043,10 +982,8 @@ browseCmd m =
 
 browseModule m exports_only = do
   s <- getSession
-  modl <- io $ GHC.findModule s (GHC.mkModuleName m) Nothing
-  is_interpreted <- io (GHC.moduleIsInterpreted s modl)
-  when (not is_interpreted && not exports_only) $
-	throwDyn (CmdLineError ("module '" ++ m ++ "' is not interpreted"))
+  modl <- if exports_only then lookupModule s m
+                          else wantInterpretedModule s m
 
   -- Temporarily set the context to the module we're interested in,
   -- just so we can get an appropriate PrintUnqualified
@@ -1167,6 +1104,7 @@ setCmd str
 	("prog":prog) -> setProg prog
         ("prompt":prompt) -> setPrompt (after 6)
         ("editor":cmd) -> setEditor (after 6)
+        ("stop":cmd) -> setStop (after 4)
 	wds -> setOptions wds
    where after n = dropWhile isSpace $ drop n $ dropWhile isSpace str
 
@@ -1184,6 +1122,10 @@ setEditor cmd = do
   st <- getGHCiState
   setGHCiState st{ editor = cmd }
 
+setStop cmd = do
+  st <- getGHCiState
+  setGHCiState st{ stop = cmd }
+
 setPrompt value = do
   st <- getGHCiState
   if null value
@@ -1277,7 +1219,8 @@ showCmd str =
 	["bindings"] -> showBindings
 	["linker"]   -> io showLinkerState
         ["breaks"] -> showBkptTable
-	_ -> throwDyn (CmdLineError "syntax:  :show [modules|bindings]")
+        ["context"] -> showContext
+	_ -> throwDyn (CmdLineError "syntax:  :show [modules|bindings|breaks]")
 
 showModules = do
   session <- getSession
@@ -1295,8 +1238,7 @@ showBindings = do
 
 showTyThing (AnId id) = do 
   ty' <- cleanType (GHC.idType id)
-  str <- showForUser (ppr id <> text " :: " <> ppr ty')
-  io (putStrLn str)
+  printForUser $ ppr id <> text " :: " <> ppr ty'
 showTyThing _  = return ()
 
 -- if -fglasgow-exts is on we show the foralls, otherwise we don't.
@@ -1310,8 +1252,14 @@ cleanType ty = do
 showBkptTable :: GHCi ()
 showBkptTable = do
    activeBreaks <- getActiveBreakPoints 
-   str <- showForUser $ ppr activeBreaks 
-   io $ putStrLn str
+   printForUser $ ppr activeBreaks 
+
+showContext :: GHCi ()
+showContext = do
+   st <- getGHCiState
+   printForUser $ vcat (map pp_resume (resume st))
+  where
+   pp_resume (span, _, _) = ptext SLIT("Stopped at") <+> ppr span
 
 -- -----------------------------------------------------------------------------
 -- Completion
@@ -1513,7 +1461,9 @@ setUpConsole = do
 #endif
 	return ()
 
+-- -----------------------------------------------------------------------------
 -- commands for debugger
+
 foreign import ccall "rts_setStepFlag" setStepFlag :: IO () 
 
 stepCmd :: String -> GHCi Bool
@@ -1530,29 +1480,28 @@ continueCmd other = do
 
 doContinue :: IO () -> GHCi Bool
 doContinue actionBeforeCont = do 
-   resumeAction <- getResume
-   popResume
+   resumeAction <- popResume
    case resumeAction of
       Nothing -> do 
          io $ putStrLn "There is no computation running."
          return False
-      Just action -> do
+      Just (_,_,handle) -> do
          io $ actionBeforeCont
-         runResult <- io action
+         session <- getSession
+         runResult <- io $ GHC.resume session handle
          names <- switchOnRunResult runResult
          finishEvalExpr names
-         return False 
+         return False
 
-deleteCmd :: String -> GHCi Bool
+deleteCmd :: String -> GHCi ()
 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 ("*":_rest) = discardActiveBreakPoints
    deleteSwitch idents = do
       mapM_ deleteOneBreak idents 
       where
@@ -1562,65 +1511,77 @@ deleteCmd argLine = do
          | otherwise = return ()
 
 -- handle the "break" command
-breakCmd :: String -> GHCi Bool
+breakCmd :: String -> GHCi ()
 breakCmd argLine = do
    session <- getSession
    breakSwitch session $ words argLine
 
-breakSwitch :: Session -> [String] -> GHCi Bool
+breakSwitch :: Session -> [String] -> GHCi ()
 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
+   | looksLikeModuleName arg1 = do
+        mod <- wantInterpretedModule session arg1
+        breakByModule session mod rest
+   | all isDigit arg1 = do
         (toplevel, _) <- io $ GHC.getContext session 
         case toplevel of
-           (mod : _) -> breakByModule mod args 
+           (mod : _) -> breakByModuleLine mod (read arg1) rest
            [] -> 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)
+   | otherwise = do -- assume it's a name
+        names <- io $ GHC.parseName session arg1
+        case names of
+          []    -> return ()
+          (n:_) -> do
+            let loc  = nameSrcLoc n
+                modl = nameModule n
+            is_interpreted <- io (GHC.moduleIsInterpreted session modl)
+            if not is_interpreted
+               then noCanDo $ text "module " <> ppr modl <>
+                              text " is not interpreted"
+               else do
+            if isGoodSrcLoc loc
+               then findBreakAndSet (nameModule n) $ 
+                         findBreakByCoord (srcLocLine loc, srcLocCol loc)
+               else noCanDo $ text "can't find its location: " <>
+                              ppr loc
+           where
+             noCanDo why = printForUser $
+                text "cannot set breakpoint on " <> ppr n <> text ": " <> why
+
+
+wantInterpretedModule :: Session -> String -> GHCi Module
+wantInterpretedModule session str = do
+   modl <- io $ GHC.findModule session (GHC.mkModuleName str) Nothing
+   is_interpreted <- io (GHC.moduleIsInterpreted session modl)
+   when (not is_interpreted) $
+       throwDyn (CmdLineError ("module '" ++ str ++ "' is not interpreted"))
+   return modl
+
+breakByModule :: Session -> Module -> [String] -> GHCi () 
+breakByModule session mod args@(arg1:rest)
    | all isDigit arg1 = do  -- looks like a line number
         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` "~!@#$%^&*-+"
+   | otherwise = io $ putStrLn "Invalid arguments to :break"
 
 breakByModuleLine :: Module -> Int -> [String] -> GHCi ()
 breakByModuleLine mod line args
-   | [] <- args = findBreakAndSet mod $ lookupTickTreeLine line
+   | [] <- args = findBreakAndSet mod $ findBreakByLine 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 $ findBreakByCoord (line, read col)
+   | otherwise = io $ putStrLn "Invalid arguments to :break"
+
+findBreakAndSet :: Module -> (TickArray -> Maybe (Int, SrcSpan)) -> GHCi ()
 findBreakAndSet mod lookupTickTree = do 
-   (breakArray, ticks) <- getModBreak mod 
-   let tickTree   = tickTreeFromList (assocs ticks)
-   case lookupTickTree tickTree of 
+   tickArray <- getTickArray mod
+   (breakArray, _) <- getModBreak mod
+   case lookupTickTree tickArray 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) <- 
@@ -1629,33 +1590,152 @@ findBreakAndSet mod lookupTickTree = do
                              , breakLoc = span
                              , breakTick = tick
                              }
-               io $ printForUser stdout unqual $
+               printForUser $
                   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" 
+            printForUser $ text "Breakpoint could not be activated at" 
                                  <+> ppr span
-            io $ putStrLn str
 
-getModBreak :: Module -> GHCi (BreakArray, Array Int SrcSpan)
+-- When a line number is specified, the current policy for choosing
+-- the best breakpoint is this:
+--    - the leftmost complete subexpression on the specified line, or
+--    - the leftmost subexpression starting on the specified line, or
+--    - the rightmost subexpression enclosing the specified line
+--
+findBreakByLine :: Int -> TickArray -> Maybe (BreakIndex,SrcSpan)
+findBreakByLine line arr
+  | not (inRange (bounds arr) line) = Nothing
+  | otherwise =
+    listToMaybe (sortBy leftmost complete)   `mplus`
+    listToMaybe (sortBy leftmost incomplete) `mplus`
+    listToMaybe (sortBy rightmost ticks)
+  where 
+        ticks = arr ! line
+
+        starts_here = [ tick | tick@(nm,span) <- ticks,
+                               srcSpanStartLine span == line ]
+
+        (complete,incomplete) = partition ends_here starts_here
+            where ends_here (nm,span) = srcSpanEndLine span == line
+
+findBreakByCoord :: (Int,Int) -> TickArray -> Maybe (BreakIndex,SrcSpan)
+findBreakByCoord (line, col) arr
+  | not (inRange (bounds arr) line) = Nothing
+  | otherwise =
+    listToMaybe (sortBy rightmost contains)
+  where 
+        ticks = arr ! line
+
+        -- the ticks that span this coordinate
+        contains = [ tick | tick@(nm,span) <- ticks, span `spans` (line,col) ]
+
+leftmost  (_,a) (_,b) = a `compare` b
+rightmost (_,a) (_,b) = b `compare` a
+
+spans :: SrcSpan -> (Int,Int) -> Bool
+spans span (l,c) = srcSpanStart span <= loc && loc <= srcSpanEnd span
+   where loc = mkSrcLoc (srcSpanFile span) l c
+
+start_bold = BS.pack "\ESC[1m"
+end_bold   = BS.pack "\ESC[0m"
+
+listCmd :: String -> GHCi ()
+listCmd str = do
+   st <- getGHCiState
+   case resume st of
+      []  -> printForUser $ text "not stopped at a breakpoint; nothing to list"
+      (span,_,_):_ -> io $ listAround span True
+
+-- | list a section of a source file around a particular SrcSpan.
+-- If the highlight flag is True, also highlight the span using
+-- start_bold/end_bold.
+listAround span do_highlight = do
+      contents <- BS.readFile (unpackFS file)
+      let 
+          lines = BS.split '\n' contents
+          these_lines = take (line2 - line1 + 1 + 2*padding) $ 
+                        drop (line1 - 1 - padding) $ lines
+          fst_line = max 1 (line1 - padding)
+          line_nos = [ fst_line .. ]
+
+          highlighted | do_highlight = zipWith highlight line_nos these_lines
+                      | otherwise   = these_lines
+
+          bs_line_nos = [ BS.pack (show l ++ "  ") | l <- line_nos ]
+          prefixed = zipWith BS.append bs_line_nos highlighted
+      --
+      BS.putStrLn (BS.join (BS.pack "\n") prefixed)
+  where
+        file  = srcSpanFile span
+        line1 = srcSpanStartLine span
+        col1  = srcSpanStartCol span
+        line2 = srcSpanEndLine span
+        col2  = srcSpanEndCol span
+        padding = 1
+
+        highlight no line
+          | no == line1 && no == line2
+          = let (a,r) = BS.splitAt col1 line
+                (b,c) = BS.splitAt (col2-col1) r
+            in
+            BS.concat [a,start_bold,b,end_bold,c]
+          | no == line1
+          = let (a,b) = BS.splitAt col1 line in
+            BS.concat [a, start_bold, b]
+          | no == line2
+          = let (a,b) = BS.splitAt col2 line in
+            BS.concat [a, end_bold, b]
+          | otherwise   = line
+
+-- --------------------------------------------------------------------------
+-- Tick arrays
+
+getTickArray :: Module -> GHCi TickArray
+getTickArray modl = do
+   st <- getGHCiState
+   let arrmap = tickarrays st
+   case lookupModuleEnv arrmap modl of
+      Just arr -> return arr
+      Nothing  -> do
+        (breakArray, ticks) <- getModBreak modl 
+        let arr = mkTickArray (assocs ticks)
+        setGHCiState st{tickarrays = extendModuleEnv arrmap modl arr}
+        return arr
+
+discardTickArrays :: GHCi ()
+discardTickArrays = do
+   st <- getGHCiState
+   setGHCiState st{tickarrays = emptyModuleEnv}
+
+mkTickArray :: [(BreakIndex,SrcSpan)] -> TickArray
+mkTickArray ticks
+  = accumArray (flip (:)) [] (1, max_line) 
+        [ (line, (nm,span)) | (nm,span) <- ticks,
+                              line <- srcSpanLines span ]
+    where
+        max_line = maximum (map srcSpanEndLine (map snd ticks))
+        srcSpanLines span = [ srcSpanStartLine span .. srcSpanEndLine span ]
+
+getModBreak :: Module -> GHCi (GHC.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
+   let array      = GHC.modBreaks_flags modBreaks
+   let ticks      = GHC.modBreaks_locs  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 :: Bool -> GHC.BreakArray -> Int -> IO Bool 
 setBreakFlag toggle array index
-   | toggle    = setBreakOn array index 
-   | otherwise = setBreakOff array index
+   | toggle    = GHC.setBreakOn array index 
+   | otherwise = GHC.setBreakOff array index
 
 
 {- these should probably go to the GHC API at some point -}