A partial attempt to improve :stepover
[ghc-hetmet.git] / compiler / ghci / InteractiveUI.hs
index 4c81bf4..a926bdc 100644 (file)
@@ -6,7 +6,7 @@
 -- (c) The GHC Team 2005-2006
 --
 -----------------------------------------------------------------------------
 -- (c) The GHC Team 2005-2006
 --
 -----------------------------------------------------------------------------
-module InteractiveUI ( interactiveUI ) where
+module InteractiveUI ( interactiveUI, ghciWelcomeMsg ) where
 
 #include "HsVersions.h"
 
 
 #include "HsVersions.h"
 
@@ -23,10 +23,12 @@ import DynFlags
 import Packages
 import PackageConfig
 import UniqFM
 import Packages
 import PackageConfig
 import UniqFM
+import HscTypes                ( implicitTyThings )
 import PprTyThing
 import Outputable       hiding (printForUser)
 import Module           -- for ModuleEnv
 import Name
 import PprTyThing
 import Outputable       hiding (printForUser)
 import Module           -- for ModuleEnv
 import Name
+import SrcLoc
 
 -- Other random utilities
 import Digraph
 
 -- Other random utilities
 import Digraph
@@ -36,6 +38,8 @@ import Config
 import StaticFlags
 import Linker
 import Util
 import StaticFlags
 import Linker
 import Util
+import NameSet
+import Maybes          ( orElse )
 import FastString
 
 #ifndef mingw32_HOST_OS
 import FastString
 
 #ifndef mingw32_HOST_OS
@@ -81,16 +85,9 @@ import System.Posix.Internals ( setNonBlockingFD )
 
 -----------------------------------------------------------------------------
 
 
 -----------------------------------------------------------------------------
 
-ghciWelcomeMsg =
- "   ___         ___ _\n"++
- "  / _ \\ /\\  /\\/ __(_)\n"++
- " / /_\\// /_/ / /  | |    GHC Interactive, version " ++ cProjectVersion ++ ", for Haskell 98.\n"++
- "/ /_\\\\/ __  / /___| |    http://www.haskell.org/ghc/\n"++
- "\\____/\\/ /_/\\____/|_|    Type :? for help.\n"
-
-ghciShortWelcomeMsg =
-    "GHCi, version " ++ cProjectVersion ++
-    ": http://www.haskell.org/ghc/  :? for help"
+ghciWelcomeMsg :: String
+ghciWelcomeMsg = "GHCi, version " ++ cProjectVersion ++
+                 ": http://www.haskell.org/ghc/  :? for help"
 
 type Command = (String, String -> GHCi Bool, Bool, String -> IO [String])
 cmdName (n,_,_,_) = n
 
 type Command = (String, String -> GHCi Bool, Bool, String -> IO [String])
 cmdName (n,_,_,_) = n
@@ -133,6 +130,7 @@ builtin_commands = [
   ("show",     keepGoing showCmd,              False, completeNone),
   ("sprint",    keepGoing sprintCmd,            False, completeIdentifier),
   ("step",      keepGoing stepCmd,              False, completeIdentifier), 
   ("show",     keepGoing showCmd,              False, completeNone),
   ("sprint",    keepGoing sprintCmd,            False, completeIdentifier),
   ("step",      keepGoing stepCmd,              False, completeIdentifier), 
+  ("stepover",  keepGoing stepOverCmd,          False, completeIdentifier), 
   ("type",     keepGoing typeOfExpr,           False, completeIdentifier),
   ("trace",     keepGoing traceCmd,             False, completeIdentifier), 
   ("undef",     keepGoing undefineMacro,       False, completeMacro),
   ("type",     keepGoing typeOfExpr,           False, completeIdentifier),
   ("trace",     keepGoing traceCmd,             False, completeIdentifier), 
   ("undef",     keepGoing undefineMacro,       False, completeMacro),
@@ -164,8 +162,8 @@ helpText =
  "   :info [<name> ...]          display information about the given names\n" ++
  "   :kind <type>                show the kind of <type>\n" ++
  "   :load <filename> ...        load module(s) and their dependents\n" ++
  "   :info [<name> ...]          display information about the given names\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" ++
  "   :main [<arguments> ...]     run the main function with the given arguments\n" ++
+ "   :module [+/-] [*]<mod> ...  set the context for expression evaluation\n" ++
  "   :quit                       exit GHCi\n" ++
  "   :reload                     reload the current module set\n" ++
  "   :type <expr>                show the type of <expr>\n" ++
  "   :quit                       exit GHCi\n" ++
  "   :reload                     reload the current module set\n" ++
  "   :type <expr>                show the type of <expr>\n" ++
@@ -188,6 +186,7 @@ helpText =
  "   :sprint [<name> ...]        simplifed version of :print\n" ++
  "   :step                       single-step after stopping at a breakpoint\n"++
  "   :step <expr>                single-step into <expr>\n"++
  "   :sprint [<name> ...]        simplifed version of :print\n" ++
  "   :step                       single-step after stopping at a breakpoint\n"++
  "   :step <expr>                single-step into <expr>\n"++
+ "   :stepover                   (locally) single-step over function applications"++
  "   :trace                      trace after stopping at a breakpoint\n"++
  "   :trace <expr>               trace into <expr> (remembers breakpoints for :history)\n"++
 
  "   :trace                      trace after stopping at a breakpoint\n"++
  "   :trace <expr>               trace into <expr> (remembers breakpoints for :history)\n"++
 
@@ -366,11 +365,6 @@ runGHCi paths maybe_expr = do
             -- initialise the console if necessary
             io setUpConsole
 
             -- initialise the console if necessary
             io setUpConsole
 
-            let msg = if dopt Opt_ShortGhciBanner dflags
-                      then ghciShortWelcomeMsg
-                      else ghciWelcomeMsg
-            when (verbosity dflags >= 1) $ io $ putStrLn msg
-
             -- enter the interactive loop
             interactiveLoop is_tty show_prompt
         Just expr -> do
             -- enter the interactive loop
             interactiveLoop is_tty show_prompt
         Just expr -> do
@@ -471,7 +465,7 @@ mkPrompt = do
                    then return (brackets (ppr (GHC.resumeSpan r)) <> space)
                    else do
                         let hist = GHC.resumeHistory r !! (ix-1)
                    then return (brackets (ppr (GHC.resumeSpan r)) <> space)
                    else do
                         let hist = GHC.resumeHistory r !! (ix-1)
-                        span <- io $ GHC.getHistorySpan session hist
+                        span <- io$ GHC.getHistorySpan session hist
                         return (brackets (ppr (negate ix) <> char ':' 
                                           <+> ppr span) <> space)
   let
                         return (brackets (ppr (negate ix) <> char ':' 
                                           <+> ppr span) <> space)
   let
@@ -566,28 +560,32 @@ runStmt stmt step
       session <- getSession
       result <- io $ withProgName (progname st) $ withArgs (args st) $
                     GHC.runStmt session stmt step
       session <- getSession
       result <- io $ withProgName (progname st) $ withArgs (args st) $
                     GHC.runStmt session stmt step
-      afterRunStmt result
+      afterRunStmt (const True) result
 
 
 
 
-afterRunStmt :: GHC.RunResult -> GHCi Bool
+--afterRunStmt :: GHC.RunResult -> GHCi Bool
                                  -- False <=> the statement failed to compile
                                  -- False <=> the statement failed to compile
-afterRunStmt (GHC.RunException e) = throw e
-afterRunStmt run_result = do
-  session <- getSession
+afterRunStmt _ (GHC.RunException e) = throw e
+afterRunStmt pred run_result = do
+  session     <- getSession
+  resumes <- io $ GHC.getResumeContext session
   case run_result of
      GHC.RunOk names -> do
         show_types <- isOptionSet ShowType
         when show_types $ printTypeOfNames session names
   case run_result of
      GHC.RunOk names -> do
         show_types <- isOptionSet ShowType
         when show_types $ printTypeOfNames session names
-     GHC.RunBreak _ names mb_info -> do
-        resumes <- io $ GHC.getResumeContext session
-        printForUser $ ptext SLIT("Stopped at") <+> 
-                       ppr (GHC.resumeSpan (head resumes))
-        printTypeOfNames session names
-        maybe (return ()) runBreakCmd mb_info
-        -- run the command set with ":set stop <cmd>"
-        st <- getGHCiState
-        enqueueCommands [stop st]
-        return ()
+     GHC.RunBreak _ names mb_info 
+         | isNothing  mb_info || 
+           pred (GHC.resumeSpan $ head resumes) -> do
+               printForUser $ ptext SLIT("Stopped at") <+> 
+                       ppr (GHC.resumeSpan $ head resumes)
+               printTypeOfNames session names
+               maybe (return ()) runBreakCmd mb_info
+               -- run the command set with ":set stop <cmd>"
+               st <- getGHCiState
+               enqueueCommands [stop st]
+               return ()
+         | otherwise -> io(GHC.resume session GHC.SingleStep) >>= 
+                        afterRunStmt pred >> return ()
      _ -> return ()
 
   flushInterpBuffers
      _ -> return ()
 
   flushInterpBuffers
@@ -640,11 +638,26 @@ lookupCommand str = do
   -- look for exact match first, then the first prefix match
   case [ c | c <- cmds, str == cmdName c ] of
      c:_ -> return (Just c)
   -- look for exact match first, then the first prefix match
   case [ c | c <- cmds, str == cmdName c ] of
      c:_ -> return (Just c)
-     [] -> case [ c | c@(s,_,_,_) <- cmds, prefixMatch str s ] of
+     [] -> case [ c | c@(s,_,_,_) <- cmds, str `isPrefixOf` s ] of
                [] -> return Nothing
                c:_ -> return (Just c)
 
 
                [] -> return Nothing
                c:_ -> return (Just c)
 
 
+getCurrentBreakTick :: GHCi (Maybe BreakIndex)
+getCurrentBreakTick = do
+  session <- getSession
+  resumes <- io $ GHC.getResumeContext session
+  case resumes of
+    [] -> return Nothing
+    (r:rs) -> do
+        let ix = GHC.resumeHistoryIx r
+        if ix == 0
+           then return (GHC.breakInfo_number `fmap` GHC.resumeBreakInfo r)
+           else do
+                let hist = GHC.resumeHistory r !! (ix-1)
+                let tick = GHC.getHistoryTick hist
+                return (Just tick)
+
 getCurrentBreakSpan :: GHCi (Maybe SrcSpan)
 getCurrentBreakSpan = do
   session <- getSession
 getCurrentBreakSpan :: GHCi (Maybe SrcSpan)
 getCurrentBreakSpan = do
   session <- getSession
@@ -660,6 +673,20 @@ getCurrentBreakSpan = do
                 span <- io $ GHC.getHistorySpan session hist
                 return (Just span)
 
                 span <- io $ GHC.getHistorySpan session hist
                 return (Just span)
 
+getCurrentBreakModule :: GHCi (Maybe Module)
+getCurrentBreakModule = do
+  session <- getSession
+  resumes <- io $ GHC.getResumeContext session
+  case resumes of
+    [] -> return Nothing
+    (r:rs) -> do
+        let ix = GHC.resumeHistoryIx r
+        if ix == 0
+           then return (GHC.breakInfo_module `liftM` GHC.resumeBreakInfo r)
+           else do
+                let hist = GHC.resumeHistory r !! (ix-1)
+                return $ Just $ GHC.getHistoryModule  hist
+
 -----------------------------------------------------------------------------
 -- Commands
 
 -----------------------------------------------------------------------------
 -- Commands
 
@@ -675,30 +702,30 @@ info "" = throwDyn (CmdLineError "syntax: ':i <thing-you-want-info-about>'")
 info s  = do { let names = words s
             ; session <- getSession
             ; dflags <- getDynFlags
 info s  = do { let names = words s
             ; session <- getSession
             ; dflags <- getDynFlags
-            ; let exts = dopt Opt_GlasgowExts dflags
-            ; mapM_ (infoThing exts session) names }
+            ; let pefas = dopt Opt_PrintExplicitForalls dflags
+            ; mapM_ (infoThing pefas session) names }
   where
   where
-    infoThing exts session str = io $ do
-       names <- GHC.parseName session str
-       let filtered = filterOutChildren names
-       mb_stuffs <- mapM (GHC.getInfo session) filtered
+    infoThing pefas session str = io $ do
+       names     <- GHC.parseName session str
+       mb_stuffs <- mapM (GHC.getInfo session) names
+       let filtered = filterOutChildren (\(t,f,i) -> t) (catMaybes mb_stuffs)
        unqual <- GHC.getPrintUnqual session
        putStrLn (showSDocForUser unqual $
                   vcat (intersperse (text "") $
        unqual <- GHC.getPrintUnqual session
        putStrLn (showSDocForUser unqual $
                   vcat (intersperse (text "") $
-                  [ pprInfo exts stuff | Just stuff <-  mb_stuffs ]))
+                        map (pprInfo pefas) filtered))
 
   -- Filter out names whose parent is also there Good
   -- example is '[]', which is both a type and data
   -- constructor in the same type
 
   -- Filter out names whose parent is also there Good
   -- example is '[]', which is both a type and data
   -- constructor in the same type
-filterOutChildren :: [Name] -> [Name]
-filterOutChildren names = filter (not . parent_is_there) names
- where parent_is_there n 
---      | Just p <- GHC.nameParent_maybe n = p `elem` names
--- ToDo!!
-        | otherwise                       = False
-
-pprInfo exts (thing, fixity, insts)
-  =  pprTyThingInContextLoc exts thing 
+filterOutChildren :: (a -> TyThing) -> [a] -> [a]
+filterOutChildren get_thing xs 
+  = [x | x <- xs, not (getName (get_thing x) `elemNameSet` implicits)]
+  where
+    implicits = mkNameSet [getName t | x <- xs, t <- implicitTyThings (get_thing x)]
+
+pprInfo :: PrintExplicitForalls -> (TyThing, Fixity, [GHC.Instance]) -> SDoc
+pprInfo pefas (thing, fixity, insts)
+  =  pprTyThingInContextLoc pefas thing
   $$ show_fixity fixity
   $$ vcat (map GHC.pprInstance insts)
   where
   $$ show_fixity fixity
   $$ vcat (map GHC.pprInstance insts)
   where
@@ -865,7 +892,7 @@ checkModule :: String -> GHCi ()
 checkModule m = do
   let modl = GHC.mkModuleName m
   session <- getSession
 checkModule m = do
   let modl = GHC.mkModuleName m
   session <- getSession
-  result <- io (GHC.checkModule session modl)
+  result <- io (GHC.checkModule session modl False)
   case result of
     Nothing -> io $ putStrLn "Nothing"
     Just r  -> io $ putStrLn (showSDoc (
   case result of
     Nothing -> io $ putStrLn "Nothing"
     Just r  -> io $ putStrLn (showSDoc (
@@ -881,8 +908,6 @@ checkModule m = do
 
 reloadModule :: String -> GHCi ()
 reloadModule m = do
 
 reloadModule :: String -> GHCi ()
 reloadModule m = do
-  io (revertCAFs)              -- always revert CAFs on reload.
-  discardActiveBreakPoints
   session <- getSession
   doLoad session $ if null m then LoadAllTargets 
                              else LoadUpTo (GHC.mkModuleName m)
   session <- getSession
   doLoad session $ if null m then LoadAllTargets 
                              else LoadUpTo (GHC.mkModuleName m)
@@ -1005,16 +1030,16 @@ browseModule m exports_only = do
     Just mod_info -> do
         let names
               | exports_only = GHC.modInfoExports mod_info
     Just mod_info -> do
         let names
               | exports_only = GHC.modInfoExports mod_info
-              | otherwise    = fromMaybe [] (GHC.modInfoTopLevelScope mod_info)
+              | otherwise    = GHC.modInfoTopLevelScope mod_info
+                               `orElse` []
 
 
-           filtered = filterOutChildren names
-       
-        things <- io $ mapM (GHC.lookupName s) filtered
+        mb_things <- io $ mapM (GHC.lookupName s) names
+       let filtered_things = filterOutChildren (\t -> t) (catMaybes mb_things)
 
         dflags <- getDynFlags
 
         dflags <- getDynFlags
-       let exts = dopt Opt_GlasgowExts dflags
+       let pefas = dopt Opt_PrintExplicitForalls dflags
        io (putStrLn (showSDocForUser unqual (
        io (putStrLn (showSDocForUser unqual (
-               vcat (map (pprTyThingInContext exts) (catMaybes things))
+               vcat (map (pprTyThingInContext pefas) filtered_things)
           )))
        -- ToDo: modInfoInstances currently throws an exception for
        -- package modules.  When it works, we can do this:
           )))
        -- ToDo: modInfoInstances currently throws an exception for
        -- package modules.  When it works, we can do this:
@@ -1276,7 +1301,7 @@ printTyThing _ = return ()
 cleanType :: Type -> GHCi Type
 cleanType ty = do
   dflags <- getDynFlags
 cleanType :: Type -> GHCi Type
 cleanType ty = do
   dflags <- getDynFlags
-  if dopt Opt_GlasgowExts dflags 
+  if dopt Opt_PrintExplicitForalls dflags 
        then return ty
        else return $! GHC.dropForAlls ty
 
        then return ty
        else return $! GHC.dropForAlls ty
 
@@ -1534,21 +1559,66 @@ pprintCommand bind force str = do
   io $ pprintClosureCommand session bind force str
 
 stepCmd :: String -> GHCi ()
   io $ pprintClosureCommand session bind force str
 
 stepCmd :: String -> GHCi ()
-stepCmd []         = doContinue GHC.SingleStep
+stepCmd []         = doContinue (const True) GHC.SingleStep
 stepCmd expression = do runStmt expression GHC.SingleStep; return ()
 
 stepCmd expression = do runStmt expression GHC.SingleStep; return ()
 
+stepOverCmd [] = do 
+  mb_span <- getCurrentBreakSpan
+  session <- getSession
+  case mb_span of
+    Nothing  -> stepCmd []
+    Just curr_loc -> do
+       Just tick   <- getCurrentBreakTick
+       Just mod    <- getCurrentBreakModule 
+       parent      <- io$ GHC.findEnclosingDeclSpanByTick session mod tick
+       allTicksRightmost <- (sortBy rightmost . map snd) `fmap` 
+                               ticksIn mod parent
+       let lastTick = null allTicksRightmost || 
+                      head allTicksRightmost == curr_loc
+       if not lastTick
+              then let f t = t `isSubspanOf` parent && 
+                             (curr_loc `leftmost_largest` t == LT)
+                   in doContinue f GHC.SingleStep
+              else printForUser (text "Warning: no more breakpoints in this function body, switching to :step") >>
+                   doContinue (const True) GHC.SingleStep
+
+stepOverCmd expression = stepCmd expression
+
+{- 
+ The first tricky bit in stepOver is detecting that we have 
+ arrived to the last tick in an expression, in which case we must
+ step normally to the next tick.
+ What we do is:
+  1. Retrieve the enclosing expression block (with a tick)
+  2. Retrieve all the ticks there and sort them out by 'rightness'
+  3. See if the current tick turned out the first one in the list
+
+ The second tricky bit is how to step over recursive calls.
+
+-}
+
+--ticksIn :: Module -> SrcSpan -> GHCi [Tick]
+ticksIn mod src = do
+  ticks <- getTickArray mod
+  let lines = [srcSpanStartLine src .. srcSpanEndLine src]
+  return [  t   | line <- lines
+                , t@(_,span) <- ticks ! line
+                , srcSpanStart src <= srcSpanStart span
+                , srcSpanEnd src   >= srcSpanEnd span
+                ]
+
 traceCmd :: String -> GHCi ()
 traceCmd :: String -> GHCi ()
-traceCmd []         = doContinue GHC.RunAndLogSteps
+traceCmd []         = doContinue (const True) GHC.RunAndLogSteps
 traceCmd expression = do runStmt expression GHC.RunAndLogSteps; return ()
 
 continueCmd :: String -> GHCi ()
 traceCmd expression = do runStmt expression GHC.RunAndLogSteps; return ()
 
 continueCmd :: String -> GHCi ()
-continueCmd = noArgs $ doContinue GHC.RunToCompletion
+continueCmd = noArgs $ doContinue (const True) GHC.RunToCompletion
 
 
-doContinue :: SingleStep -> GHCi ()
-doContinue step = do 
+-- doContinue :: SingleStep -> GHCi ()
+doContinue pred step = do 
   session <- getSession
   runResult <- io $ GHC.resume session step
   session <- getSession
   runResult <- io $ GHC.resume session step
-  afterRunStmt runResult
+  afterRunStmt pred runResult
   return ()
 
 abandonCmd :: String -> GHCi ()
   return ()
 
 abandonCmd :: String -> GHCi ()
@@ -1590,10 +1660,18 @@ historyCmd arg
         let hist = GHC.resumeHistory r
             (took,rest) = splitAt num hist
         spans <- mapM (io . GHC.getHistorySpan s) took
         let hist = GHC.resumeHistory r
             (took,rest) = splitAt num hist
         spans <- mapM (io . GHC.getHistorySpan s) took
-        let nums = map (printf "-%-3d:") [(1::Int)..]
-        printForUser (vcat (zipWith (<+>) (map text nums) (map ppr spans)))
+        let nums  = map (printf "-%-3d:") [(1::Int)..]
+        let names = map GHC.historyEnclosingDecl took
+        printForUser (vcat(zipWith3 
+                             (\x y z -> x <+> y <+> z) 
+                             (map text nums) 
+                             (map (bold . ppr) names)
+                             (map (parens . ppr) spans)))
         io $ putStrLn $ if null rest then "<end of history>" else "..."
 
         io $ putStrLn $ if null rest then "<end of history>" else "..."
 
+bold c | do_bold   = text start_bold <> c <> text end_bold
+       | otherwise = c
+
 backCmd :: String -> GHCi ()
 backCmd = noArgs $ do
   s <- getSession
 backCmd :: String -> GHCi ()
 backCmd = noArgs $ do
   s <- getSession
@@ -1653,14 +1731,17 @@ 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
 breakByModule session mod args@(arg1:rest)
    | all isDigit arg1 = do  -- looks like a line number
         breakByModuleLine mod (read arg1) rest
-   | otherwise = io $ putStrLn "Invalid arguments to :break"
+breakByModule session mod _
+   = breakSyntax
 
 breakByModuleLine :: Module -> Int -> [String] -> GHCi ()
 breakByModuleLine mod line args
    | [] <- args = findBreakAndSet mod $ findBreakByLine line
    | [col] <- args, all isDigit col =
         findBreakAndSet mod $ findBreakByCoord Nothing (line, read col)
 
 breakByModuleLine :: Module -> Int -> [String] -> GHCi ()
 breakByModuleLine mod line args
    | [] <- args = findBreakAndSet mod $ findBreakByLine line
    | [col] <- args, all isDigit col =
         findBreakAndSet mod $ findBreakByCoord Nothing (line, read col)
-   | otherwise = io $ putStrLn "Invalid arguments to :break"
+   | otherwise = breakSyntax
+
+breakSyntax = throwDyn (CmdLineError "Syntax: :break [<mod>] <line> [<column>]")
 
 findBreakAndSet :: Module -> (TickArray -> Maybe (Int, SrcSpan)) -> GHCi ()
 findBreakAndSet mod lookupTickTree = do 
 
 findBreakAndSet :: Module -> (TickArray -> Maybe (Int, SrcSpan)) -> GHCi ()
 findBreakAndSet mod lookupTickTree = do 
@@ -1699,9 +1780,9 @@ findBreakByLine :: Int -> TickArray -> Maybe (BreakIndex,SrcSpan)
 findBreakByLine line arr
   | not (inRange (bounds arr) line) = Nothing
   | otherwise =
 findBreakByLine line arr
   | not (inRange (bounds arr) line) = Nothing
   | otherwise =
-    listToMaybe (sortBy leftmost_largest  complete)   `mplus`
-    listToMaybe (sortBy leftmost_smallest incomplete) `mplus`
-    listToMaybe (sortBy rightmost ticks)
+    listToMaybe (sortBy (leftmost_largest `on` snd)  complete)   `mplus`
+    listToMaybe (sortBy (leftmost_smallest `on` snd) incomplete) `mplus`
+    listToMaybe (sortBy (rightmost `on` snd) ticks)
   where 
         ticks = arr ! line
 
   where 
         ticks = arr ! line
 
@@ -1716,8 +1797,8 @@ findBreakByCoord :: Maybe FastString -> (Int,Int) -> TickArray
 findBreakByCoord mb_file (line, col) arr
   | not (inRange (bounds arr) line) = Nothing
   | otherwise =
 findBreakByCoord mb_file (line, col) arr
   | not (inRange (bounds arr) line) = Nothing
   | otherwise =
-    listToMaybe (sortBy rightmost contains) `mplus`
-    listToMaybe (sortBy leftmost_smallest after_here)
+    listToMaybe (sortBy (rightmost `on` snd) contains ++
+                 sortBy (leftmost_smallest `on` snd) after_here)
   where 
         ticks = arr ! line
 
   where 
         ticks = arr ! line
 
@@ -1733,17 +1814,6 @@ findBreakByCoord mb_file (line, col) arr
                               GHC.srcSpanStartLine span == line,
                               GHC.srcSpanStartCol span >= col ]
 
                               GHC.srcSpanStartLine span == line,
                               GHC.srcSpanStartCol span >= col ]
 
-
-leftmost_smallest  (_,a) (_,b) = a `compare` b
-leftmost_largest   (_,a) (_,b) = (GHC.srcSpanStart a `compare` GHC.srcSpanStart b)
-                                `thenCmp`
-                                 (GHC.srcSpanEnd b `compare` GHC.srcSpanEnd a)
-rightmost (_,a) (_,b) = b `compare` a
-
-spans :: SrcSpan -> (Int,Int) -> Bool
-spans span (l,c) = GHC.srcSpanStart span <= loc && loc <= GHC.srcSpanEnd span
-   where loc = GHC.mkSrcLoc (GHC.srcSpanFile span) l c
-
 -- for now, use ANSI bold on Unixy systems.  On Windows, we add a line
 -- of carets under the active expression instead.  The Windows console
 -- doesn't support ANSI escape sequences, and most Unix terminals
 -- for now, use ANSI bold on Unixy systems.  On Windows, we add a line
 -- of carets under the active expression instead.  The Windows console
 -- doesn't support ANSI escape sequences, and most Unix terminals
@@ -1755,8 +1825,8 @@ do_bold = True
 do_bold = False
 #endif
 
 do_bold = False
 #endif
 
-start_bold = BS.pack "\ESC[1m"
-end_bold   = BS.pack "\ESC[0m"
+start_bold = "\ESC[1m"
+end_bold   = "\ESC[0m"
 
 listCmd :: String -> GHCi ()
 listCmd "" = do
 
 listCmd :: String -> GHCi ()
 listCmd "" = do
@@ -1813,8 +1883,7 @@ listModuleLine modl line = do
 -- If the highlight flag is True, also highlight the span using
 -- start_bold/end_bold.
 listAround span do_highlight = do
 -- If the highlight flag is True, also highlight the span using
 -- start_bold/end_bold.
 listAround span do_highlight = do
-      pwd      <- getEnv "PWD" 
-      contents <- BS.readFile (pwd `joinFileName` unpackFS file)
+      contents <- BS.readFile (unpackFS file)
       let 
           lines = BS.split '\n' contents
           these_lines = take (line2 - line1 + 1 + pad_before + pad_after) $ 
       let 
           lines = BS.split '\n' contents
           these_lines = take (line2 - line1 + 1 + pad_before + pad_after) $ 
@@ -1848,13 +1917,13 @@ listAround span do_highlight = do
           = let (a,r) = BS.splitAt col1 line
                 (b,c) = BS.splitAt (col2-col1) r
             in
           = let (a,r) = BS.splitAt col1 line
                 (b,c) = BS.splitAt (col2-col1) r
             in
-            BS.concat [a,start_bold,b,end_bold,c]
+            BS.concat [a,BS.pack start_bold,b,BS.pack end_bold,c]
           | no == line1
           = let (a,b) = BS.splitAt col1 line in
           | no == line1
           = let (a,b) = BS.splitAt col1 line in
-            BS.concat [a, start_bold, b]
+            BS.concat [a, BS.pack start_bold, b]
           | no == line2
           = let (a,b) = BS.splitAt col2 line in
           | no == line2
           = let (a,b) = BS.splitAt col2 line in
-            BS.concat [a, end_bold, b]
+            BS.concat [a, BS.pack end_bold, b]
           | otherwise   = line
 
         highlight_carets no line
           | otherwise   = line
 
         highlight_carets no line