let you :show things that you can :set (e.g. args, prog etc.)

[ghc-hetmet.git] / compiler / ghci / InteractiveUI.hs

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index fc4f30d..3a76f92 100644 (file)
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -21,7 +21,7 @@ import Debugger
 import qualified GHC
 import GHC              ( Session, LoadHowMuch(..), Target(..),  TargetId(..),
                           Type, Module, ModuleName, TyThing(..), Phase,
 import qualified GHC
 import GHC              ( Session, LoadHowMuch(..), Target(..),  TargetId(..),
                           Type, Module, ModuleName, TyThing(..), Phase,

-                          BreakIndex, Name, SrcSpan, Resume )
+                          BreakIndex, Name, SrcSpan, Resume, SingleStep )

 import DynFlags
 import Packages
 import PackageConfig
 import DynFlags
 import Packages
 import PackageConfig

@@ -74,6 +74,7 @@ import Data.Char
 import Data.Dynamic
 import Data.Array
 import Control.Monad as Monad
 import Data.Dynamic
 import Data.Array
 import Control.Monad as Monad

+import Text.Printf

 
 import Foreign.StablePtr       ( newStablePtr )
 import GHC.Exts                ( unsafeCoerce# )
 
 import Foreign.StablePtr       ( newStablePtr )
 import GHC.Exts                ( unsafeCoerce# )

@@ -104,6 +105,7 @@ builtin_commands = [
   ("add",      keepGoingPaths addModule,       False, completeFilename),
   ("abandon",   keepGoing abandonCmd,           False, completeNone),
   ("break",     keepGoing breakCmd,             False, completeIdentifier),
   ("add",      keepGoingPaths addModule,       False, completeFilename),
   ("abandon",   keepGoing abandonCmd,           False, completeNone),
   ("break",     keepGoing breakCmd,             False, completeIdentifier),

+  ("back",      keepGoing backCmd,              False, completeNone),

   ("browse",    keepGoing browseCmd,           False, completeModule),
   ("cd",       keepGoing changeDirectory,      False, completeFilename),
   ("check",    keepGoing checkModule,          False, completeHomeModule),
   ("browse",    keepGoing browseCmd,           False, completeModule),
   ("cd",       keepGoing changeDirectory,      False, completeFilename),
   ("check",    keepGoing checkModule,          False, completeHomeModule),

@@ -115,7 +117,9 @@ builtin_commands = [
   ("edit",     keepGoing editFile,             False, completeFilename),
   ("etags",    keepGoing createETagsFileCmd,   False, completeFilename),
   ("force",     keepGoing forceCmd,             False, completeIdentifier),
   ("edit",     keepGoing editFile,             False, completeFilename),
   ("etags",    keepGoing createETagsFileCmd,   False, completeFilename),
   ("force",     keepGoing forceCmd,             False, completeIdentifier),

+  ("forward",   keepGoing forwardCmd,           False, completeNone),

   ("help",     keepGoing help,                 False, completeNone),
   ("help",     keepGoing help,                 False, completeNone),

+  ("history",   keepGoing historyCmd,           False, completeNone), 

   ("info",      keepGoing info,                        False, completeIdentifier),
   ("kind",     keepGoing kindOfType,           False, completeIdentifier),
   ("load",     keepGoingPaths loadModule_,     False, completeHomeModuleOrFile),
   ("info",      keepGoing info,                        False, completeIdentifier),
   ("kind",     keepGoing kindOfType,           False, completeIdentifier),
   ("load",     keepGoingPaths loadModule_,     False, completeHomeModuleOrFile),

@@ -130,6 +134,7 @@ builtin_commands = [
   ("sprint",    keepGoing sprintCmd,            False, completeIdentifier),
   ("step",      stepCmd,                        False, completeIdentifier), 
   ("type",     keepGoing typeOfExpr,           False, completeIdentifier),
   ("sprint",    keepGoing sprintCmd,            False, completeIdentifier),
   ("step",      stepCmd,                        False, completeIdentifier), 
   ("type",     keepGoing typeOfExpr,           False, completeIdentifier),

+  ("trace",     traceCmd,                       False, completeIdentifier), 

   ("undef",     keepGoing undefineMacro,       False, completeMacro),
   ("unset",    keepGoing unsetOptions,         True,  completeSetOptions)
   ]
   ("undef",     keepGoing undefineMacro,       False, completeMacro),
   ("unset",    keepGoing unsetOptions,         True,  completeSetOptions)
   ]

@@ -268,7 +273,8 @@ interactiveUI session srcs maybe_expr = do
                   session = session,
                   options = [],
                    prelude = prel_mod,
                   session = session,
                   options = [],
                    prelude = prel_mod,

-                   breaks = emptyActiveBreakPoints,
+                   break_ctr = 0,
+                   breaks = [],

                    tickarrays = emptyModuleEnv
                  }
 
                    tickarrays = emptyModuleEnv
                  }
 

@@ -412,11 +418,9 @@ checkPerms name =
 
 fileLoop :: Handle -> Bool -> GHCi ()
 fileLoop hdl show_prompt = do
 
 fileLoop :: Handle -> Bool -> GHCi ()
 fileLoop hdl show_prompt = do

-   session <- getSession
-   (mod,imports) <- io (GHC.getContext session)
-   st <- getGHCiState
-   resumes <- io $ GHC.getResumeContext session
-   when show_prompt (io (putStr (mkPrompt mod imports resumes (prompt st))))
+   when show_prompt $ do
+        prompt <- mkPrompt
+        (io (putStr prompt))

    l <- io (IO.try (hGetLine hdl))
    case l of
        Left e | isEOFError e              -> return ()
    l <- io (IO.try (hGetLine hdl))
    case l of
        Left e | isEOFError e              -> return ()

@@ -441,25 +445,40 @@ stringLoop (s:ss) = do
        l  -> do quit <- runCommand l
                  if quit then return True else stringLoop ss
 
        l  -> do quit <- runCommand l
                  if quit then return True else stringLoop ss
 

-mkPrompt toplevs exports resumes prompt
-  = showSDoc $ f prompt
-    where
-        f ('%':'s':xs) = perc_s <> f xs
-        f ('%':'%':xs) = char '%' <> f xs
-        f (x:xs) = char x <> f xs
-        f [] = empty
-    
-        perc_s
-          | eval:rest <- resumes 
-          = (if not (null rest) then text "... " else empty)
-            <> brackets (ppr (GHC.resumeSpan eval)) <+> modules_prompt
-          | otherwise
-          = modules_prompt
-
-        modules_prompt = 
+mkPrompt = do
+  session <- getSession
+  (toplevs,exports) <- io (GHC.getContext session)
+  resumes <- io $ GHC.getResumeContext session
+
+  context_bit <-
+        case resumes of
+            [] -> return empty
+            r:rs -> do
+                let ix = GHC.resumeHistoryIx r
+                if ix == 0
+                   then return (brackets (ppr (GHC.resumeSpan r)) <> space)
+                   else do
+                        let hist = GHC.resumeHistory r !! (ix-1)
+                        span <- io $ GHC.getHistorySpan session hist
+                        return (brackets (ppr (negate ix) <> char ':' 
+                                          <+> ppr span) <> space)
+  let
+        dots | r:rs <- resumes, not (null rs) = text "... "
+             | otherwise = empty
+
+        modules_bit = 

              hsep (map (\m -> char '*' <> ppr (GHC.moduleName m)) toplevs) <+>
              hsep (map (ppr . GHC.moduleName) exports)
 
              hsep (map (\m -> char '*' <> ppr (GHC.moduleName m)) toplevs) <+>
              hsep (map (ppr . GHC.moduleName) exports)
 

+        deflt_prompt = dots <> context_bit <> modules_bit
+
+        f ('%':'s':xs) = deflt_prompt <> f xs
+        f ('%':'%':xs) = char '%' <> f xs
+        f (x:xs) = char x <> f xs
+        f [] = empty
+   --
+  st <- getGHCiState
+  return (showSDoc (f (prompt st)))

 
 
 #ifdef USE_READLINE
 
 
 #ifdef USE_READLINE

@@ -470,9 +489,9 @@ readlineLoop = do
    io yield
    saveSession -- for use by completion
    st <- getGHCiState
    io yield
    saveSession -- for use by completion
    st <- getGHCiState

-   resumes <- io $ GHC.getResumeContext session
-   l <- io (readline (mkPrompt mod imports resumes (prompt st))
-               `finally` setNonBlockingFD 0)
+   mb_span <- getCurrentBreakSpan
+   prompt <- mkPrompt
+   l <- io (readline prompt `finally` setNonBlockingFD 0)

                -- readline sometimes puts stdin into blocking mode,
                -- so we need to put it back for the IO library
    splatSavedSession
                -- readline sometimes puts stdin into blocking mode,
                -- so we need to put it back for the IO library
    splatSavedSession

@@ -492,7 +511,7 @@ runCommand c = ghciHandle handler (doCommand c)
   where 
     doCommand (':' : command) = specialCommand command
     doCommand stmt
   where 
     doCommand (':' : command) = specialCommand command
     doCommand stmt

-       = do timeIt $ runStmt stmt
+       = do timeIt $ runStmt stmt GHC.RunToCompletion

             return False
 
 -- This version is for the GHC command-line option -e.  The only difference
             return False
 
 -- This version is for the GHC command-line option -e.  The only difference

@@ -506,28 +525,27 @@ runCommandEval c = ghciHandle handleEval (doCommand c)
 
     doCommand (':' : command) = specialCommand command
     doCommand stmt
 
     doCommand (':' : command) = specialCommand command
     doCommand stmt

-       = do r <- runStmt stmt
+       = do r <- runStmt stmt GHC.RunToCompletion

            case r of 
                False -> io (exitWith (ExitFailure 1))
                  -- failure to run the command causes exit(1) for ghc -e.
                _       -> return True
 
            case r of 
                False -> io (exitWith (ExitFailure 1))
                  -- failure to run the command causes exit(1) for ghc -e.
                _       -> return True
 

-runStmt :: String -> GHCi Bool
-runStmt stmt
+runStmt :: String -> SingleStep -> GHCi Bool
+runStmt stmt step

  | null (filter (not.isSpace) stmt) = return False
  | otherwise
  = do st <- getGHCiState
       session <- getSession
       result <- io $ withProgName (progname st) $ withArgs (args st) $
  | null (filter (not.isSpace) stmt) = return False
  | otherwise
  = do st <- getGHCiState
       session <- getSession
       result <- io $ withProgName (progname st) $ withArgs (args st) $

-                    GHC.runStmt session stmt
+                    GHC.runStmt session stmt step

       afterRunStmt result
       afterRunStmt result

-      return False
+      return (isRunResultOk result)

 
 
 afterRunStmt :: GHC.RunResult -> GHCi (Maybe (Bool,[Name]))
 afterRunStmt run_result = do
   mb_result <- switchOnRunResult run_result
 
 
 afterRunStmt :: GHC.RunResult -> GHCi (Maybe (Bool,[Name]))
 afterRunStmt run_result = do
   mb_result <- switchOnRunResult run_result

-

   -- possibly print the type and revert CAFs after evaluating an expression
   show_types <- isOptionSet ShowType
   session <- getSession
   -- possibly print the type and revert CAFs after evaluating an expression
   show_types <- isOptionSet ShowType
   session <- getSession

@@ -566,6 +584,11 @@ switchOnRunResult (GHC.RunBreak threadId names info) = do
    return (Just (True,names))
 
 
    return (Just (True,names))
 
 

+isRunResultOk :: GHC.RunResult -> Bool
+isRunResultOk (GHC.RunOk _) = True
+isRunResultOk _             = False
+
+

 showTypeOfName :: Session -> Name -> GHCi ()
 showTypeOfName session n
    = do maybe_tything <- io (GHC.lookupName session n)
 showTypeOfName :: Session -> Name -> GHCi ()
 showTypeOfName session n
    = do maybe_tything <- io (GHC.lookupName session n)

@@ -593,9 +616,29 @@ lookupCommand str = do
                [] -> return Nothing
                c:_ -> return (Just c)
 
                [] -> return Nothing
                c:_ -> return (Just c)
 

+
+getCurrentBreakSpan :: GHCi (Maybe SrcSpan)
+getCurrentBreakSpan = 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 (Just (GHC.resumeSpan r))
+           else do
+                let hist = GHC.resumeHistory r !! (ix-1)
+                span <- io $ GHC.getHistorySpan session hist
+                return (Just span)
+

 -----------------------------------------------------------------------------
 -- Commands
 
 -----------------------------------------------------------------------------
 -- Commands
 

+noArgs :: GHCi () -> String -> GHCi ()
+noArgs m "" = m
+noArgs m _ = io $ putStrLn "This command takes no arguments"
+

 help :: String -> GHCi ()
 help _ = io (putStr helpText)
 
 help :: String -> GHCi ()
 help _ = io (putStr helpText)
 

@@ -880,8 +923,8 @@ browseCmd m =
 
 browseModule m exports_only = do
   s <- getSession
 
 browseModule m exports_only = do
   s <- getSession

-  modl <- if exports_only then lookupModule s m
-                          else wantInterpretedModule s m
+  modl <- if exports_only then lookupModule m
+                          else wantInterpretedModule m

 
   -- Temporarily set the context to the module we're interested in,
   -- just so we can get an appropriate PrintUnqualified
 
   -- Temporarily set the context to the module we're interested in,
   -- just so we can get an appropriate PrintUnqualified

@@ -1111,14 +1154,20 @@ optToStr RevertCAFs = "r"
 -- ---------------------------------------------------------------------------
 -- code for `:show'
 
 -- ---------------------------------------------------------------------------
 -- code for `:show'
 

-showCmd str =
+showCmd str = do
+  st <- getGHCiState

   case words str of
   case words str of

+        ["args"]     -> io $ putStrLn (show (args st))
+        ["prog"]     -> io $ putStrLn (show (progname st))
+        ["prompt"]   -> io $ putStrLn (show (prompt st))
+        ["editor"]   -> io $ putStrLn (show (editor st))
+        ["stop"]     -> io $ putStrLn (show (stop st))

        ["modules" ] -> showModules
        ["bindings"] -> showBindings
        ["linker"]   -> io showLinkerState
        ["modules" ] -> showModules
        ["bindings"] -> showBindings
        ["linker"]   -> io showLinkerState

-        ["breaks"] -> showBkptTable
-        ["context"] -> showContext
-       _ -> throwDyn (CmdLineError "syntax:  :show [modules|bindings|breaks]")
+        ["breaks"]   -> showBkptTable
+        ["context"]  -> showContext
+       _ -> throwDyn (CmdLineError "syntax:  :show [args|prog|prompt|editor|stop|modules|bindings|breaks|context]")

 
 showModules = do
   session <- getSession
 
 showModules = do
   session <- getSession

@@ -1149,8 +1198,8 @@ cleanType ty = do
 
 showBkptTable :: GHCi ()
 showBkptTable = do
 
 showBkptTable :: GHCi ()
 showBkptTable = do

-   activeBreaks <- getActiveBreakPoints 
-   printForUser $ ppr activeBreaks 
+  st <- getGHCiState
+  printForUser $ prettyLocations (breaks st)

 
 showContext :: GHCi ()
 showContext = do
 
 showContext :: GHCi ()
 showContext = do

@@ -1339,6 +1388,28 @@ expandPath path =
    other -> 
        return other
 
    other -> 
        return other
 

+wantInterpretedModule :: String -> GHCi Module
+wantInterpretedModule str = do
+   session <- getSession
+   modl <- lookupModule str
+   is_interpreted <- io (GHC.moduleIsInterpreted session modl)
+   when (not is_interpreted) $
+       throwDyn (CmdLineError ("module '" ++ str ++ "' is not interpreted"))
+   return modl
+
+wantNameFromInterpretedModule noCanDo str and_then = do
+   session <- getSession
+   names <- io $ GHC.parseName session str
+   case names of
+      []    -> return ()
+      (n:_) -> do
+            let modl = GHC.nameModule n
+            is_interpreted <- io (GHC.moduleIsInterpreted session modl)
+            if not is_interpreted
+               then noCanDo n $ text "module " <> ppr modl <>
+                                text " is not interpreted"
+               else and_then n
+

 -- ----------------------------------------------------------------------------
 -- Windows console setup
 
 -- ----------------------------------------------------------------------------
 -- Windows console setup
 

@@ -1375,33 +1446,32 @@ pprintCommand bind force str = do
   io $ pprintClosureCommand session bind force str
 
 stepCmd :: String -> GHCi Bool
   io $ pprintClosureCommand session bind force str
 
 stepCmd :: String -> GHCi Bool

-stepCmd [] = doContinue True
-stepCmd expression = do
-   runCommand expression
+stepCmd []         = doContinue GHC.SingleStep
+stepCmd expression = runStmt expression GHC.SingleStep
+
+traceCmd :: String -> GHCi Bool
+traceCmd []         = doContinue GHC.RunAndLogSteps
+traceCmd expression = runStmt expression GHC.RunAndLogSteps

 
 continueCmd :: String -> GHCi Bool
 
 continueCmd :: String -> GHCi Bool

-continueCmd [] = doContinue False
+continueCmd [] = doContinue GHC.RunToCompletion

 continueCmd other = do
    io $ putStrLn "The continue command accepts no arguments."
    return False
 
 continueCmd other = do
    io $ putStrLn "The continue command accepts no arguments."
    return False
 

-doContinue :: Bool -> GHCi Bool
+doContinue :: SingleStep -> GHCi Bool

 doContinue step = do 
   session <- getSession
 doContinue step = do 
   session <- getSession

-  let resume | step      = GHC.stepResume
-             | otherwise = GHC.resume
-  runResult <- io $ resume session
+  runResult <- io $ GHC.resume session step

   afterRunStmt runResult
   return False
 
 abandonCmd :: String -> GHCi ()
   afterRunStmt runResult
   return False
 
 abandonCmd :: String -> GHCi ()

-abandonCmd "" = do
+abandonCmd = noArgs $ do

   s <- getSession
   b <- io $ GHC.abandon s -- the prompt will change to indicate the new context
   when (not b) $ io $ putStrLn "There is no computation running."
   return ()
   s <- getSession
   b <- io $ GHC.abandon s -- the prompt will change to indicate the new context
   when (not b) $ io $ putStrLn "There is no computation running."
   return ()

-abandonCmd _ = do
-   io $ putStrLn "The abandon command accepts no arguments."

 
 deleteCmd :: String -> GHCi ()
 deleteCmd argLine = do
 
 deleteCmd :: String -> GHCi ()
 deleteCmd argLine = do

@@ -1420,6 +1490,49 @@ deleteCmd argLine = do
          | all isDigit str = deleteBreak (read str)
          | otherwise = return ()
 
          | all isDigit str = deleteBreak (read str)
          | otherwise = return ()
 

+historyCmd :: String -> GHCi ()
+historyCmd arg
+  | null arg        = history 20
+  | all isDigit arg = history (read arg)
+  | otherwise       = io $ putStrLn "Syntax:  :history [num]"
+  where
+  history num = do
+    s <- getSession
+    resumes <- io $ GHC.getResumeContext s
+    case resumes of
+      [] -> io $ putStrLn "Not stopped at a breakpoint"
+      (r:rs) -> do
+        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)))
+        io $ putStrLn $ if null rest then "<end of history>" else "..."
+
+backCmd :: String -> GHCi ()
+backCmd = noArgs $ do
+  s <- getSession
+  (names, ix, span) <- io $ GHC.back s
+  printForUser $ ptext SLIT("Logged breakpoint at") <+> ppr span
+  mapM_ (showTypeOfName s) names
+   -- run the command set with ":set stop <cmd>"
+  st <- getGHCiState
+  runCommand (stop st)
+  return ()
+
+forwardCmd :: String -> GHCi ()
+forwardCmd = noArgs $ do
+  s <- getSession
+  (names, ix, span) <- io $ GHC.forward s
+  printForUser $ (if (ix == 0)
+                    then ptext SLIT("Stopped at")
+                    else ptext SLIT("Logged breakpoint at")) <+> ppr span
+  mapM_ (showTypeOfName s) names
+   -- run the command set with ":set stop <cmd>"
+  st <- getGHCiState
+  runCommand (stop st)
+  return ()
+

 -- handle the "break" command
 breakCmd :: String -> GHCi ()
 breakCmd argLine = do
 -- handle the "break" command
 breakCmd :: String -> GHCi ()
 breakCmd argLine = do

@@ -1431,7 +1544,7 @@ breakSwitch _session [] = do
    io $ putStrLn "The break command requires at least one argument."
 breakSwitch session args@(arg1:rest) 
    | looksLikeModuleName arg1 = do
    io $ putStrLn "The break command requires at least one argument."
 breakSwitch session args@(arg1:rest) 
    | looksLikeModuleName arg1 = do

-        mod <- wantInterpretedModule session arg1
+        mod <- wantInterpretedModule arg1

         breakByModule session mod rest
    | all isDigit arg1 = do
         (toplevel, _) <- io $ GHC.getContext session 
         breakByModule session mod rest
    | all isDigit arg1 = do
         (toplevel, _) <- io $ GHC.getContext session 

@@ -1440,38 +1553,19 @@ breakSwitch session args@(arg1:rest)
            [] -> do 
               io $ putStrLn "Cannot find default module for breakpoint." 
               io $ putStrLn "Perhaps no modules are loaded for debugging?"
            [] -> do 
               io $ putStrLn "Cannot find default module for breakpoint." 
               io $ putStrLn "Perhaps no modules are loaded for debugging?"

-   | otherwise = do -- assume it's a name
-        names <- io $ GHC.parseName session arg1
-        case names of
-          []    -> return ()
-          (n:_) -> do
-            let loc  = GHC.nameSrcLoc n
-                modl = GHC.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 GHC.isGoodSrcLoc loc
-               then findBreakAndSet (GHC.nameModule n) $ 
+   | otherwise = do -- try parsing it as an identifier
+        wantNameFromInterpretedModule noCanDo arg1 $ \name -> do
+        let loc = GHC.nameSrcLoc name
+        if GHC.isGoodSrcLoc loc
+               then findBreakAndSet (GHC.nameModule name) $ 

                          findBreakByCoord (Just (GHC.srcLocFile loc))
                                           (GHC.srcLocLine loc, 
                                            GHC.srcLocCol loc)
                          findBreakByCoord (Just (GHC.srcLocFile loc))
                                           (GHC.srcLocLine loc, 
                                            GHC.srcLocCol loc)

-               else noCanDo $ text "can't find its location: " <>
-                              ppr loc
-           where
-             noCanDo why = printForUser $
+               else noCanDo name $ text "can't find its location: " <> ppr loc
+       where
+          noCanDo n why = printForUser $

                 text "cannot set breakpoint on " <> ppr n <> text ": " <> why
 
                 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
 breakByModule :: Session -> Module -> [String] -> GHCi () 
 breakByModule session mod args@(arg1:rest)
    | all isDigit arg1 = do  -- looks like a line number

@@ -1565,12 +1659,54 @@ start_bold = BS.pack "\ESC[1m"
 end_bold   = BS.pack "\ESC[0m"
 
 listCmd :: String -> GHCi ()
 end_bold   = BS.pack "\ESC[0m"
 
 listCmd :: String -> GHCi ()

-listCmd str = do
+listCmd "" = do
+   mb_span <- getCurrentBreakSpan
+   case mb_span of
+      Nothing  -> printForUser $ text "not stopped at a breakpoint; nothing to list"
+      Just span -> io $ listAround span True
+listCmd str = list2 (words str)
+
+list2 [arg] | all isDigit arg = do
+    session <- getSession
+    (toplevel, _) <- io $ GHC.getContext session 
+    case toplevel of
+        [] -> io $ putStrLn "No module to list"
+        (mod : _) -> listModuleLine mod (read arg)
+list2 [arg1,arg2] | looksLikeModuleName arg1, all isDigit arg2 = do
+        mod <- wantInterpretedModule arg1
+        listModuleLine mod (read arg2)
+list2 [arg] = do
+        wantNameFromInterpretedModule noCanDo arg $ \name -> do
+        let loc = GHC.nameSrcLoc name
+        if GHC.isGoodSrcLoc loc
+               then do
+                  tickArray <- getTickArray (GHC.nameModule name)
+                  let mb_span = findBreakByCoord (Just (GHC.srcLocFile loc))
+                                        (GHC.srcLocLine loc, GHC.srcLocCol loc)
+                                        tickArray
+                  case mb_span of
+                    Nothing       -> io $ listAround (GHC.srcLocSpan loc) False
+                    Just (_,span) -> io $ listAround span False
+               else
+                  noCanDo name $ text "can't find its location: " <>
+                                 ppr loc
+    where
+        noCanDo n why = printForUser $
+            text "cannot list source code for " <> ppr n <> text ": " <> why
+list2  _other = 
+        io $ putStrLn "syntax:  :list [<line> | <module> <line> | <identifier>]"
+
+listModuleLine :: Module -> Int -> GHCi ()
+listModuleLine modl line = do

    session <- getSession
    session <- getSession

-   resumes <- io $ GHC.getResumeContext session
-   case resumes of
-      []  -> printForUser $ text "not stopped at a breakpoint; nothing to list"
-      eval:_ -> io $ listAround (GHC.resumeSpan eval) True
+   graph <- io (GHC.getModuleGraph session)
+   let this = filter ((== modl) . GHC.ms_mod) graph
+   case this of
+     [] -> panic "listModuleLine"
+     summ:_ -> do
+           let filename = fromJust (ml_hs_file (GHC.ms_location summ))
+               loc = GHC.mkSrcLoc (mkFastString (filename)) line 0
+           io $ listAround (GHC.srcLocSpan loc) False

 
 -- | list a section of a source file around a particular SrcSpan.
 -- If the highlight flag is True, also highlight the span using
 
 -- | list a section of a source file around a particular SrcSpan.
 -- If the highlight flag is True, also highlight the span using

@@ -1646,6 +1782,34 @@ mkTickArray ticks
         srcSpanLines span = [ GHC.srcSpanStartLine span .. 
                               GHC.srcSpanEndLine span ]
 
         srcSpanLines span = [ GHC.srcSpanStartLine span .. 
                               GHC.srcSpanEndLine span ]
 

+lookupModule :: String -> GHCi Module
+lookupModule modName
+   = do session <- getSession 
+        io (GHC.findModule session (GHC.mkModuleName modName) Nothing)
+
+-- don't reset the counter back to zero?
+discardActiveBreakPoints :: GHCi ()
+discardActiveBreakPoints = do
+   st <- getGHCiState
+   mapM (turnOffBreak.snd) (breaks st)
+   setGHCiState $ st { breaks = [] }
+
+deleteBreak :: Int -> GHCi ()
+deleteBreak identity = do
+   st <- getGHCiState
+   let oldLocations    = breaks st
+       (this,rest)     = partition (\loc -> fst loc == identity) oldLocations
+   if null this 
+      then printForUser (text "Breakpoint" <+> ppr identity <+>
+                         text "does not exist")
+      else do
+           mapM (turnOffBreak.snd) this
+           setGHCiState $ st { breaks = rest }
+
+turnOffBreak loc = do
+  (arr, _) <- getModBreak (breakModule loc)
+  io $ setBreakFlag False arr (breakTick loc)
+

 getModBreak :: Module -> GHCi (GHC.BreakArray, Array Int SrcSpan)
 getModBreak mod = do
    session <- getSession
 getModBreak :: Module -> GHCi (GHC.BreakArray, Array Int SrcSpan)
 getModBreak mod = do
    session <- getSession

@@ -1655,28 +1819,8 @@ getModBreak mod = do
    let ticks      = GHC.modBreaks_locs  modBreaks
    return (array, ticks)
 
    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 -> GHC.BreakArray -> Int -> IO Bool 
 setBreakFlag toggle array index
    | toggle    = GHC.setBreakOn array index 
    | otherwise = GHC.setBreakOff array index
 
 setBreakFlag :: Bool -> GHC.BreakArray -> Int -> IO Bool 
 setBreakFlag toggle array index
    | toggle    = GHC.setBreakOn array index 
    | otherwise = GHC.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 ()