refactor: combine repeated code in file reloading

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

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index 3a76f92..98baccd 100644 (file)
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -70,6 +70,7 @@ import System.Exit    ( exitWith, ExitCode(..) )
 import System.Directory
 import System.IO
 import System.IO.Error as IO
 import System.Directory
 import System.IO
 import System.IO.Error as IO

+import System.FilePath

 import Data.Char
 import Data.Dynamic
 import Data.Array
 import Data.Char
 import Data.Dynamic
 import Data.Array

@@ -109,7 +110,8 @@ builtin_commands = [
   ("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),

-  ("continue",  continueCmd,                    False, completeNone),
+  ("continue",  keepGoing continueCmd,          False, completeNone),
+  ("cmd",       keepGoing cmdCmd,               False, completeIdentifier),

   ("ctags",    keepGoing createCTagsFileCmd,   False, completeFilename),
   ("def",      keepGoing defineMacro,          False, completeIdentifier),
   ("delete",    keepGoing deleteCmd,            False, completeNone),
   ("ctags",    keepGoing createCTagsFileCmd,   False, completeFilename),
   ("def",      keepGoing defineMacro,          False, completeIdentifier),
   ("delete",    keepGoing deleteCmd,            False, completeNone),

@@ -132,9 +134,9 @@ builtin_commands = [
   ("set",      keepGoing setCmd,               True,  completeSetOptions),
   ("show",     keepGoing showCmd,              False, completeNone),
   ("sprint",    keepGoing sprintCmd,            False, completeIdentifier),
   ("set",      keepGoing setCmd,               True,  completeSetOptions),
   ("show",     keepGoing showCmd,              False, completeNone),
   ("sprint",    keepGoing sprintCmd,            False, completeIdentifier),

-  ("step",      stepCmd,                        False, completeIdentifier), 
+  ("step",      keepGoing stepCmd,              False, completeIdentifier), 

   ("type",     keepGoing typeOfExpr,           False, completeIdentifier),
   ("type",     keepGoing typeOfExpr,           False, completeIdentifier),

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

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

@@ -150,31 +152,49 @@ shortHelpText = "use :? for help.\n"
 helpText =
  " Commands available from the prompt:\n" ++
  "\n" ++
 helpText =
  " Commands available from the prompt:\n" ++
  "\n" ++

- "   <stmt>                      evaluate/run <stmt>\n" ++
+ "   <statement>                 evaluate/run <statement>\n" ++

  "   :add <filename> ...         add module(s) to the current target set\n" ++
  "   :add <filename> ...         add module(s) to the current target set\n" ++

- "   :abandon                    at a breakpoint, abandon current computation\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" ++
  "   :browse [*]<module>         display the names defined by <module>\n" ++
  "   :cd <dir>                   change directory to <dir>\n" ++

- "   :continue                   resume after a breakpoint\n" ++
+ "   :cmd <expr>                 run the commands returned by <expr>::IO String"++

  "   :ctags [<file>]             create tags file for Vi (default: \"tags\")\n" ++
  "   :def <cmd> <expr>           define a command :<cmd>\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" ++
  "   :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" ++
  "   :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" ++
  "   :help, :?                   display this list of commands\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" ++

- "   :print [<name> ...]         prints a value without forcing its computation\n" ++

  "   :quit                       exit GHCi\n" ++
  "   :reload                     reload the current module set\n" ++
  "   :quit                       exit GHCi\n" ++
  "   :reload                     reload the current module set\n" ++

+ "   :type <expr>                show the type of <expr>\n" ++
+ "   :undef <cmd>                undefine user-defined command :<cmd>\n" ++
+ "   :!<command>                 run the shell command <command>\n" ++
+ "\n" ++
+ " -- Commands for debugging:\n" ++
+ "\n" ++
+ "   :abandon                    at a breakpoint, abandon current computation\n" ++
+ "   :back                       go back in the history (after :trace)\n" ++
+ "   :break [<mod>] <l> [<col>]  set a breakpoint at the specified location\n" ++
+ "   :break <name>               set a breakpoint on the specified function\n" ++
+ "   :continue                   resume after a breakpoint\n" ++
+ "   :delete <number>            delete the specified breakpoint\n" ++
+ "   :delete *                   delete all breakpoints\n" ++
+ "   :force <expr>               print <expr>, forcing unevaluated parts\n" ++
+ "   :forward                    go forward in the history (after :back)\n" ++
+ "   :history [<n>]              show the last <n> items in the history (after :trace)\n" ++
+ "   :print [<name> ...]         prints a value without forcing its computation\n" ++
+ "   :sprint [<name> ...]        simplifed version of :print\n" ++
+ "   :step                       single-step after stopping at a breakpoint\n"++
+ "   :step <expr>                single-step into <expr>\n"++
+ "   :trace                      trace after stopping at a breakpoint\n"++
+ "   :trace <expr>               trace into <expr> (remembers breakpoints for :history)\n"++
+
+ "\n" ++
+ " -- Commands for changing settings:\n" ++

  "\n" ++
  "   :set <option> ...           set options\n" ++
  "   :set args <arg> ...         set the arguments returned by System.getArgs\n" ++
  "\n" ++
  "   :set <option> ...           set options\n" ++
  "   :set args <arg> ...         set the arguments returned by System.getArgs\n" ++

@@ -182,29 +202,24 @@ helpText =
  "   :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" ++
  "   :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" ++
- "   :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" ++
- "   :undef <cmd>                undefine user-defined command :<cmd>\n" ++

  "   :unset <option> ...         unset options\n" ++
  "   :unset <option> ...         unset options\n" ++

- "   :!<command>                 run the shell command <command>\n" ++

  "\n" ++
  "\n" ++

- " Options for ':set' and ':unset':\n" ++
+ "  Options for ':set' and ':unset':\n" ++

  "\n" ++
  "    +r            revert top-level expressions after each evaluation\n" ++
  "    +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" ++
  "\n" ++
  "    +r            revert top-level expressions after each evaluation\n" ++
  "    +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" ++

+ "\n" ++
+ " -- Commands for displaying information:\n" ++
+ "\n" ++
+ "   :show bindings              show the current bindings made at the prompt\n" ++
+ "   :show breaks                show the active breakpoints\n" ++
+ "   :show context               show the breakpoint context\n" ++
+ "   :show modules               show the currently loaded modules\n" ++
+ "   :show <setting>             show anything that can be set with :set (e.g. args)\n" ++

  "\n" 
  "\n" 

--- Todo: add help for breakpoint commands here

 
 findEditor = do
   getEnv "EDITOR" 
 
 findEditor = do
   getEnv "EDITOR" 

@@ -275,7 +290,8 @@ interactiveUI session srcs maybe_expr = do
                    prelude = prel_mod,
                    break_ctr = 0,
                    breaks = [],
                    prelude = prel_mod,
                    break_ctr = 0,
                    breaks = [],

-                   tickarrays = emptyModuleEnv
+                   tickarrays = emptyModuleEnv,
+                   cmdqueue = []

                  }
 
 #ifdef USE_READLINE
                  }
 
 #ifdef USE_READLINE

@@ -434,17 +450,9 @@ fileLoop hdl show_prompt = do
        Right l -> 
          case removeSpaces l of
             "" -> fileLoop hdl show_prompt
        Right l -> 
          case removeSpaces l of
             "" -> fileLoop hdl show_prompt

-           l  -> do quit <- runCommand l
+           l  -> do quit <- runCommands l

                      if quit then return () else fileLoop hdl show_prompt
 
                      if quit then return () else fileLoop hdl show_prompt
 

-stringLoop :: [String] -> GHCi Bool{-True: we quit-}
-stringLoop [] = return False
-stringLoop (s:ss) = do
-   case removeSpaces s of
-       "" -> stringLoop ss
-       l  -> do quit <- runCommand l
-                 if quit then return True else stringLoop ss
-

 mkPrompt = do
   session <- getSession
   (toplevs,exports) <- io (GHC.getContext session)
 mkPrompt = do
   session <- getSession
   (toplevs,exports) <- io (GHC.getContext session)

@@ -502,17 +510,31 @@ readlineLoop = do
            "" -> readlineLoop
            l  -> do
                  io (addHistory l)
            "" -> readlineLoop
            l  -> do
                  io (addHistory l)

-                 quit <- runCommand l
+                 quit <- runCommands l

                  if quit then return () else readlineLoop
 #endif
 
                  if quit then return () else readlineLoop
 #endif
 

-runCommand :: String -> GHCi Bool
-runCommand c = ghciHandle handler (doCommand c)
-  where 
-    doCommand (':' : command) = specialCommand command
-    doCommand stmt
-       = do timeIt $ runStmt stmt GHC.RunToCompletion
-            return False
+runCommands :: String -> GHCi Bool
+runCommands cmd = do
+        q <- ghciHandle handler (doCommand cmd)
+        if q then return True else runNext
+  where
+       runNext = do
+          st <- getGHCiState
+          case cmdqueue st of
+            []   -> return False
+            c:cs -> do setGHCiState st{ cmdqueue = cs }
+                       runCommands c
+
+       doCommand (':' : cmd) = specialCommand cmd
+       doCommand stmt        = do timeIt $ runStmt stmt GHC.RunToCompletion
+                                  return False
+
+enqueueCommands :: [String] -> GHCi ()
+enqueueCommands cmds = do
+  st <- getGHCiState
+  setGHCiState st{ cmdqueue = cmds ++ cmdqueue st }
+

 
 -- This version is for the GHC command-line option -e.  The only difference
 -- from runCommand is that it catches the ExitException exception and
 
 -- This version is for the GHC command-line option -e.  The only difference
 -- from runCommand is that it catches the ExitException exception and

@@ -534,60 +556,54 @@ runCommandEval c = ghciHandle handleEval (doCommand c)
 runStmt :: String -> SingleStep -> GHCi Bool
 runStmt stmt step
  | null (filter (not.isSpace) stmt) = return False
 runStmt :: String -> SingleStep -> GHCi Bool
 runStmt stmt step
  | null (filter (not.isSpace) stmt) = return False

+ | ["import", mod] <- words stmt    = keepGoing setContext ('+':mod)

  | otherwise
  = do st <- getGHCiState
       session <- getSession
       result <- io $ withProgName (progname st) $ withArgs (args st) $
                     GHC.runStmt session stmt step
       afterRunStmt result
  | otherwise
  = do st <- getGHCiState
       session <- getSession
       result <- io $ withProgName (progname st) $ withArgs (args st) $
                     GHC.runStmt session stmt step
       afterRunStmt result

-      return (isRunResultOk result)

 
 
 
 

-afterRunStmt :: GHC.RunResult -> GHCi (Maybe (Bool,[Name]))
+afterRunStmt :: GHC.RunResult -> GHCi Bool
+                                 -- False <=> the statement failed to compile
+afterRunStmt (GHC.RunException e) = throw e

 afterRunStmt run_result = do
 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
   session <- getSession

-  case mb_result of
-    Nothing    -> return ()      
-    Just (is_break,names) -> 
-            when (is_break || show_types) $
-                  mapM_ (showTypeOfName session) names
-  
+  case run_result of
+     GHC.RunOk names -> do
+        show_types <- isOptionSet ShowType
+        when show_types $ mapM_ (showTypeOfName session) names
+     GHC.RunBreak _ names mb_info -> do
+        resumes <- io $ GHC.getResumeContext session
+        printForUser $ ptext SLIT("Stopped at") <+> 
+                       ppr (GHC.resumeSpan (head resumes))
+        mapM_ (showTypeOfName session) names
+        maybe (return ()) runBreakCmd mb_info
+        -- run the command set with ":set stop <cmd>"
+        st <- getGHCiState
+        enqueueCommands [stop st]
+        return ()
+     _ -> return ()
+

   flushInterpBuffers
   io installSignalHandlers
   b <- isOptionSet RevertCAFs
   io (when b revertCAFs)
 
   flushInterpBuffers
   io installSignalHandlers
   b <- isOptionSet RevertCAFs
   io (when b revertCAFs)
 

-  return mb_result
-
-
-switchOnRunResult :: GHC.RunResult -> GHCi (Maybe (Bool,[Name]))
-switchOnRunResult GHC.RunFailed = return Nothing
-switchOnRunResult (GHC.RunException e) = throw e
-switchOnRunResult (GHC.RunOk names) = return $ Just (False,names)
-switchOnRunResult (GHC.RunBreak threadId names info) = do
-   session <- getSession
-   Just mod_info <- io $ GHC.getModuleInfo session (GHC.breakInfo_module info) 
-   let modBreaks  = GHC.modInfoModBreaks mod_info
-   let ticks      = GHC.modBreaks_locs modBreaks
-
-   -- display information about the breakpoint
-   let location = ticks ! GHC.breakInfo_number info
-   printForUser $ ptext SLIT("Stopped at") <+> ppr location
-
-   -- run the command set with ":set stop <cmd>"
-   st <- getGHCiState
-   runCommand (stop st)
-
-   return (Just (True,names))
-
-
-isRunResultOk :: GHC.RunResult -> Bool
-isRunResultOk (GHC.RunOk _) = True
-isRunResultOk _             = False
+  return (case run_result of GHC.RunOk _ -> True; _ -> False)

 
 

+runBreakCmd :: GHC.BreakInfo -> GHCi ()
+runBreakCmd info = do
+  let mod = GHC.breakInfo_module info
+      nm  = GHC.breakInfo_number info
+  st <- getGHCiState
+  case  [ loc | (i,loc) <- breaks st,
+                breakModule loc == mod, breakTick loc == nm ] of
+        []  -> return ()
+        loc:_ | null cmd  -> return ()
+              | otherwise -> do enqueueCommands [cmd]; return ()
+              where cmd = onBreakCmd loc

 
 showTypeOfName :: Session -> Name -> GHCi ()
 showTypeOfName session n
 
 showTypeOfName :: Session -> Name -> GHCi ()
 showTypeOfName session n

@@ -681,8 +697,7 @@ pprInfo exts (thing, fixity, insts)
 runMain :: String -> GHCi ()
 runMain args = do
   let ss = concat $ intersperse "," (map (\ s -> ('"':s)++"\"") (toArgs args))
 runMain :: String -> GHCi ()
 runMain args = do
   let ss = concat $ intersperse "," (map (\ s -> ('"':s)++"\"") (toArgs args))

-  runCommand $ '[': ss ++ "] `System.Environment.withArgs` main"
-  return ()
+  enqueueCommands  ['[': ss ++ "] `System.Environment.withArgs` main"]

 
 addModule :: [FilePath] -> GHCi ()
 addModule files = do
 
 addModule :: [FilePath] -> GHCi ()
 addModule files = do

@@ -708,25 +723,47 @@ changeDirectory dir = do
   io (setCurrentDirectory dir)
 
 editFile :: String -> GHCi ()
   io (setCurrentDirectory dir)
 
 editFile :: String -> GHCi ()

-editFile str
-  | null str  = do
-       -- find the name of the "topmost" file loaded
-     session <- getSession
-     graph0 <- io (GHC.getModuleGraph session)
-     graph1 <- filterM (io . GHC.isLoaded session . GHC.ms_mod_name) graph0
-     let graph2 = flattenSCCs (GHC.topSortModuleGraph True graph1 Nothing)
-     case GHC.ml_hs_file (GHC.ms_location (last graph2)) of
-       Just file -> do_edit file
-       Nothing   -> throwDyn (CmdLineError "unknown file name")
-  | otherwise = do_edit str
-  where
-       do_edit file = do
-          st <- getGHCiState
-          let cmd = editor st
-          when (null cmd) $ 
-               throwDyn (CmdLineError "editor not set, use :set editor")
-          io $ system (cmd ++ ' ':file)
-           return ()
+editFile str =
+  do file <- if null str then chooseEditFile else return str
+     st <- getGHCiState
+     let cmd = editor st
+     when (null cmd) 
+       $ throwDyn (CmdLineError "editor not set, use :set editor")
+     io $ system (cmd ++ ' ':file)
+     return ()
+
+-- The user didn't specify a file so we pick one for them.
+-- Our strategy is to pick the first module that failed to load,
+-- or otherwise the first target.
+--
+-- XXX: Can we figure out what happened if the depndecy analysis fails
+--      (e.g., because the porgrammeer mistyped the name of a module)?
+-- XXX: Can we figure out the location of an error to pass to the editor?
+-- XXX: if we could figure out the list of errors that occured during the
+-- last load/reaload, then we could start the editor focused on the first
+-- of those.
+chooseEditFile :: GHCi String
+chooseEditFile =
+  do session <- getSession
+     let hasFailed x = io $ fmap not $ GHC.isLoaded session $ GHC.ms_mod_name x
+
+     graph <- io (GHC.getModuleGraph session)
+     failed_graph <- filterM hasFailed graph
+     let order g  = flattenSCCs $ GHC.topSortModuleGraph True g Nothing
+         pick xs  = case xs of
+                      x : _ -> GHC.ml_hs_file (GHC.ms_location x)
+                      _     -> Nothing
+
+     case pick (order failed_graph) of
+       Just file -> return file
+       Nothing   -> 
+         do targets <- io (GHC.getTargets session)
+            case msum (map fromTarget targets) of
+              Just file -> return file
+              Nothing   -> throwDyn (CmdLineError "No files to edit.")
+          
+  where fromTarget (GHC.Target (GHC.TargetFile f _) _) = Just f
+        fromTarget _ = Nothing -- when would we get a module target?

 
 defineMacro :: String -> GHCi ()
 defineMacro s = do
 
 defineMacro :: String -> GHCi ()
 defineMacro s = do

@@ -755,7 +792,8 @@ defineMacro s = do
 runMacro :: GHC.HValue{-String -> IO String-} -> String -> GHCi Bool
 runMacro fun s = do
   str <- io ((unsafeCoerce# fun :: String -> IO String) s)
 runMacro :: GHC.HValue{-String -> IO String-} -> String -> GHCi Bool
 runMacro fun s = do
   str <- io ((unsafeCoerce# fun :: String -> IO String) s)

-  stringLoop (lines str)
+  enqueueCommands (lines str)
+  return False

 
 undefineMacro :: String -> GHCi ()
 undefineMacro macro_name = do
 
 undefineMacro :: String -> GHCi ()
 undefineMacro macro_name = do

@@ -770,6 +808,17 @@ undefineMacro macro_name = do
        else do
   io (writeIORef commands (filter ((/= macro_name) . cmdName) cmds))
 
        else do
   io (writeIORef commands (filter ((/= macro_name) . cmdName) cmds))
 

+cmdCmd :: String -> GHCi ()
+cmdCmd str = do
+  let expr = '(' : str ++ ") :: IO String"
+  session <- getSession
+  maybe_hv <- io (GHC.compileExpr session expr)
+  case maybe_hv of
+    Nothing -> return ()
+    Just hv -> do 
+        cmds <- io $ (unsafeCoerce# hv :: IO String)
+        enqueueCommands (lines cmds)
+        return ()

 
 loadModule :: [(FilePath, Maybe Phase)] -> GHCi SuccessFlag
 loadModule fs = timeIt (loadModule' fs)
 
 loadModule :: [(FilePath, Maybe Phase)] -> GHCi SuccessFlag
 loadModule fs = timeIt (loadModule' fs)

@@ -782,6 +831,7 @@ loadModule' files = do
   session <- getSession
 
   -- unload first
   session <- getSession
 
   -- unload first

+  discardActiveBreakPoints

   io (GHC.setTargets session [])
   io (GHC.load session LoadAllTargets)
 
   io (GHC.setTargets session [])
   io (GHC.load session LoadAllTargets)
 

@@ -797,9 +847,7 @@ loadModule' files = do
   -- as a ToDo for now.
 
   io (GHC.setTargets session targets)
   -- as a ToDo for now.
 
   io (GHC.setTargets session targets)

-  ok <- io (GHC.load session LoadAllTargets)
-  afterLoad ok session
-  return ok
+  doLoad session LoadAllTargets

 
 checkModule :: String -> GHCi ()
 checkModule m = do
 
 checkModule :: String -> GHCi ()
 checkModule m = do

@@ -820,21 +868,25 @@ checkModule m = do
   afterLoad (successIf (isJust result)) session
 
 reloadModule :: String -> GHCi ()
   afterLoad (successIf (isJust result)) session
 
 reloadModule :: String -> GHCi ()

-reloadModule "" = do
-  io (revertCAFs)              -- always revert CAFs on reload.
-  session <- getSession
-  ok <- io (GHC.load session LoadAllTargets)
-  afterLoad ok session

 reloadModule m = do
   io (revertCAFs)              -- always revert CAFs on reload.
 reloadModule m = do
   io (revertCAFs)              -- always revert CAFs on reload.

+  discardActiveBreakPoints

   session <- getSession
   session <- getSession

-  ok <- io (GHC.load session (LoadUpTo (GHC.mkModuleName m)))
+  doLoad session $ if null m then LoadAllTargets 
+                             else LoadUpTo (GHC.mkModuleName m)
+  return ()
+
+doLoad session howmuch = do
+  -- turn off breakpoints before we load: we can't turn them off later, because
+  -- the ModBreaks will have gone away.
+  discardActiveBreakPoints
+  ok <- io (GHC.load session howmuch)

   afterLoad ok session
   afterLoad ok session

+  return ok

 
 afterLoad ok session = do
   io (revertCAFs)  -- always revert CAFs on load.
   discardTickArrays
 
 afterLoad ok session = do
   io (revertCAFs)  -- always revert CAFs on load.
   discardTickArrays

-  discardActiveBreakPoints

   graph <- io (GHC.getModuleGraph session)
   graph' <- filterM (io . GHC.isLoaded session . GHC.ms_mod_name) graph
   setContextAfterLoad session graph'
   graph <- io (GHC.getModuleGraph session)
   graph' <- filterM (io . GHC.isLoaded session . GHC.ms_mod_name) graph
   setContextAfterLoad session graph'

@@ -1063,6 +1115,19 @@ setEditor cmd = do
   st <- getGHCiState
   setGHCiState st{ editor = cmd }
 
   st <- getGHCiState
   setGHCiState st{ editor = cmd }
 

+setStop str@(c:_) | isDigit c
+  = do let (nm_str,rest) = break (not.isDigit) str
+           nm = read nm_str
+       st <- getGHCiState
+       let old_breaks = breaks st
+       if all ((/= nm) . fst) old_breaks
+              then printForUser (text "Breakpoint" <+> ppr nm <+>
+                                 text "does not exist")
+              else do
+       let new_breaks = map fn old_breaks
+           fn (i,loc) | i == nm   = (i,loc { onBreakCmd = dropWhile isSpace rest })
+                      | otherwise = (i,loc)
+       setGHCiState st{ breaks = new_breaks }

 setStop cmd = do
   st <- getGHCiState
   setGHCiState st{ stop = cmd }
 setStop cmd = do
   st <- getGHCiState
   setGHCiState st{ stop = cmd }

@@ -1080,8 +1145,10 @@ setOptions wds =
    do -- first, deal with the GHCi opts (+s, +t, etc.)
       let (plus_opts, minus_opts)  = partition isPlus wds
       mapM_ setOpt plus_opts
    do -- first, deal with the GHCi opts (+s, +t, etc.)
       let (plus_opts, minus_opts)  = partition isPlus wds
       mapM_ setOpt plus_opts

-

       -- then, dynamic flags
       -- then, dynamic flags

+      newDynFlags minus_opts
+
+newDynFlags minus_opts = do

       dflags <- getDynFlags
       let pkg_flags = packageFlags dflags
       (dflags',leftovers) <- io $ GHC.parseDynamicFlags dflags minus_opts
       dflags <- getDynFlags
       let pkg_flags = packageFlags dflags
       (dflags',leftovers) <- io $ GHC.parseDynamicFlags dflags minus_opts

@@ -1119,10 +1186,11 @@ unsetOptions str
 
        mapM_ unsetOpt plus_opts
  
 
        mapM_ unsetOpt plus_opts
  

-       -- can't do GHC flags for now
-       if (not (null minus_opts))
-         then throwDyn (CmdLineError "can't unset GHC command-line flags")
-         else return ()
+       let no_flag ('-':'f':rest) = return ("-fno-" ++ rest)
+           no_flag f = throwDyn (ProgramError ("don't know how to reverse " ++ f))
+
+       no_flags <- mapM no_flag minus_opts
+       newDynFlags no_flags

 
 isMinus ('-':s) = True
 isMinus _ = False
 
 isMinus ('-':s) = True
 isMinus _ = False

@@ -1445,26 +1513,23 @@ pprintCommand bind force str = do
   session <- getSession
   io $ pprintClosureCommand session bind force str
 
   session <- getSession
   io $ pprintClosureCommand session bind force str
 

-stepCmd :: String -> GHCi Bool
+stepCmd :: String -> GHCi ()

 stepCmd []         = doContinue GHC.SingleStep
 stepCmd []         = doContinue GHC.SingleStep

-stepCmd expression = runStmt expression GHC.SingleStep
+stepCmd expression = do runStmt expression GHC.SingleStep; return ()

 
 

-traceCmd :: String -> GHCi Bool
+traceCmd :: String -> GHCi ()

 traceCmd []         = doContinue GHC.RunAndLogSteps
 traceCmd []         = doContinue GHC.RunAndLogSteps

-traceCmd expression = runStmt expression GHC.RunAndLogSteps
+traceCmd expression = do runStmt expression GHC.RunAndLogSteps; return ()

 
 

-continueCmd :: String -> GHCi Bool
-continueCmd [] = doContinue GHC.RunToCompletion
-continueCmd other = do
-   io $ putStrLn "The continue command accepts no arguments."
-   return False
+continueCmd :: String -> GHCi ()
+continueCmd = noArgs $ doContinue GHC.RunToCompletion

 
 

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

 doContinue step = do 
   session <- getSession
   runResult <- io $ GHC.resume session step
   afterRunStmt runResult
 doContinue step = do 
   session <- getSession
   runResult <- io $ GHC.resume session step
   afterRunStmt runResult

-  return False
+  return ()

 
 abandonCmd :: String -> GHCi ()
 abandonCmd = noArgs $ do
 
 abandonCmd :: String -> GHCi ()
 abandonCmd = noArgs $ do

@@ -1517,8 +1582,7 @@ backCmd = noArgs $ do
   mapM_ (showTypeOfName s) names
    -- run the command set with ":set stop <cmd>"
   st <- getGHCiState
   mapM_ (showTypeOfName s) names
    -- run the command set with ":set stop <cmd>"
   st <- getGHCiState

-  runCommand (stop st)
-  return ()
+  enqueueCommands [stop st]

 
 forwardCmd :: String -> GHCi ()
 forwardCmd = noArgs $ do
 
 forwardCmd :: String -> GHCi ()
 forwardCmd = noArgs $ do

@@ -1530,8 +1594,7 @@ forwardCmd = noArgs $ do
   mapM_ (showTypeOfName s) names
    -- run the command set with ":set stop <cmd>"
   st <- getGHCiState
   mapM_ (showTypeOfName s) names
    -- run the command set with ":set stop <cmd>"
   st <- getGHCiState

-  runCommand (stop st)
-  return ()
+  enqueueCommands [stop st]

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

@@ -1555,7 +1618,7 @@ breakSwitch session args@(arg1:rest)
               io $ putStrLn "Perhaps no modules are loaded for debugging?"
    | otherwise = do -- try parsing it as an identifier
         wantNameFromInterpretedModule noCanDo arg1 $ \name -> do
               io $ putStrLn "Perhaps no modules are loaded for debugging?"
    | otherwise = do -- try parsing it as an identifier
         wantNameFromInterpretedModule noCanDo arg1 $ \name -> do

-        let loc = GHC.nameSrcLoc name
+        let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)

         if GHC.isGoodSrcLoc loc
                then findBreakAndSet (GHC.nameModule name) $ 
                          findBreakByCoord (Just (GHC.srcLocFile loc))
         if GHC.isGoodSrcLoc loc
                then findBreakAndSet (GHC.nameModule name) $ 
                          findBreakByCoord (Just (GHC.srcLocFile loc))

@@ -1595,6 +1658,7 @@ findBreakAndSet mod lookupTickTree = do
                              { breakModule = mod
                              , breakLoc = span
                              , breakTick = tick
                              { breakModule = mod
                              , breakLoc = span
                              , breakTick = tick

+                             , onBreakCmd = ""

                              }
                printForUser $
                   text "Breakpoint " <> ppr nm <>
                              }
                printForUser $
                   text "Breakpoint " <> ppr nm <>

@@ -1632,7 +1696,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)
+    listToMaybe (sortBy rightmost contains) `mplus`
+    listToMaybe (sortBy leftmost_smallest after_here)

   where 
         ticks = arr ! line
 
   where 
         ticks = arr ! line
 

@@ -1644,6 +1709,10 @@ findBreakByCoord mb_file (line, col) arr
                  | Just f <- mb_file = GHC.srcSpanFile span == f
                  | otherwise         = True
 
                  | Just f <- mb_file = GHC.srcSpanFile span == f
                  | otherwise         = True
 

+        after_here = [ tick | tick@(nm,span) <- ticks,
+                              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)
 
 leftmost_smallest  (_,a) (_,b) = a `compare` b
 leftmost_largest   (_,a) (_,b) = (GHC.srcSpanStart a `compare` GHC.srcSpanStart b)

@@ -1655,6 +1724,17 @@ 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
 
 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
+-- (including xterm) do, so this is a reasonable guess until we have a
+-- proper termcap/terminfo library.
+#if !defined(mingw32_TARGET_OS)
+do_bold = True
+#else
+do_bold = False
+#endif
+

 start_bold = BS.pack "\ESC[1m"
 end_bold   = BS.pack "\ESC[0m"
 
 start_bold = BS.pack "\ESC[1m"
 end_bold   = BS.pack "\ESC[0m"
 

@@ -1663,7 +1743,8 @@ listCmd "" = do
    mb_span <- getCurrentBreakSpan
    case mb_span of
       Nothing  -> printForUser $ text "not stopped at a breakpoint; nothing to list"
    mb_span <- getCurrentBreakSpan
    case mb_span of
       Nothing  -> printForUser $ text "not stopped at a breakpoint; nothing to list"

-      Just span -> io $ listAround span True
+      Just span | GHC.isGoodSrcSpan span -> io $ listAround span True
+                | otherwise              -> printForUser $ text "unable to list source for" <+> ppr span

 listCmd str = list2 (words str)
 
 list2 [arg] | all isDigit arg = do
 listCmd str = list2 (words str)
 
 list2 [arg] | all isDigit arg = do

@@ -1677,7 +1758,7 @@ list2 [arg1,arg2] | looksLikeModuleName arg1, all isDigit arg2 = do
         listModuleLine mod (read arg2)
 list2 [arg] = do
         wantNameFromInterpretedModule noCanDo arg $ \name -> do
         listModuleLine mod (read arg2)
 list2 [arg] = do
         wantNameFromInterpretedModule noCanDo arg $ \name -> do

-        let loc = GHC.nameSrcLoc name
+        let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)

         if GHC.isGoodSrcLoc loc
                then do
                   tickArray <- getTickArray (GHC.nameModule name)
         if GHC.isGoodSrcLoc loc
                then do
                   tickArray <- getTickArray (GHC.nameModule name)

@@ -1712,7 +1793,8 @@ 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

-      contents <- BS.readFile (unpackFS file)
+      pwd      <- getEnv "PWD" 
+      contents <- BS.readFile (pwd </> 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) $ 

@@ -1738,7 +1820,10 @@ listAround span do_highlight = do
                    | otherwise  = 1
         pad_after = 1
 
                    | otherwise  = 1
         pad_after = 1
 

-        highlight no line
+        highlight | do_bold   = highlight_bold
+                  | otherwise = highlight_carets
+
+        highlight_bold no line

           | no == line1 && no == line2
           = let (a,r) = BS.splitAt col1 line
                 (b,c) = BS.splitAt (col2-col1) r
           | no == line1 && no == line2
           = let (a,r) = BS.splitAt col1 line
                 (b,c) = BS.splitAt (col2-col1) r

@@ -1752,6 +1837,20 @@ listAround span do_highlight = do
             BS.concat [a, end_bold, b]
           | otherwise   = line
 
             BS.concat [a, end_bold, b]
           | otherwise   = line
 

+        highlight_carets no line
+          | no == line1 && no == line2
+          = BS.concat [line, nl, indent, BS.replicate col1 ' ',
+                                         BS.replicate (col2-col1) '^']
+          | no == line1
+          = BS.concat [line, nl, indent, BS.replicate col1 ' ',
+                                         BS.replicate (BS.length line-col1) '^']
+          | no == line2
+          = BS.concat [line, nl, indent, BS.replicate col2 '^']
+          | otherwise   = line
+         where
+           indent = BS.pack "   "
+           nl = BS.singleton '\n'
+

 -- --------------------------------------------------------------------------
 -- Tick arrays
 
 -- --------------------------------------------------------------------------
 -- Tick arrays
 

@@ -1778,7 +1877,7 @@ mkTickArray ticks
         [ (line, (nm,span)) | (nm,span) <- ticks,
                               line <- srcSpanLines span ]
     where
         [ (line, (nm,span)) | (nm,span) <- ticks,
                               line <- srcSpanLines span ]
     where

-        max_line = maximum (map GHC.srcSpanEndLine (map snd ticks))
+        max_line = foldr max 0 (map GHC.srcSpanEndLine (map snd ticks))

         srcSpanLines span = [ GHC.srcSpanStartLine span .. 
                               GHC.srcSpanEndLine span ]
 
         srcSpanLines span = [ GHC.srcSpanStartLine span .. 
                               GHC.srcSpanEndLine span ]