X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FInteractiveUI.hs;h=5f9f74fab62cbf02d7e715f8ba4ca2f7d873d6a2;hb=3d0ad8a75e9874e222e2e149b8914e2ed74af7b8;hp=9b0bdf956465f3a8de4444447fdac8a989781dde;hpb=10406dfbd1a90e0ca813cc2809719263642d9a97;p=ghc-hetmet.git

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index 9b0bdf9..5f9f74f 100644
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -74,6 +74,7 @@ import Data.Char
 import Data.Dynamic
 import Data.Array
 import Control.Monad as Monad
+import Text.Printf
 
 import Foreign.StablePtr	( newStablePtr )
 import GHC.Exts		( unsafeCoerce# )
@@ -149,31 +150,48 @@ shortHelpText = "use :? for help.\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" ++
- "   :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" ++
- "   :continue                   resume after a breakpoint\n" ++
  "   :ctags [<file>]             create tags file for Vi (default: \"tags\")\n" ++
  "   :def <cmd> <expr>           define a command :<cmd>\n" ++
- "   :delete <number>            delete the specified breakpoint\n" ++
- "   :delete *                   delete all breakpoints\n" ++
  "   :edit <file>                edit file\n" ++
  "   :edit                       edit last module\n" ++
  "   :etags [<file>]             create tags file for Emacs (default: \"TAGS\")\n" ++
--- "   :force <expr>               print <expr>, forcing unevaluated parts\n" ++
  "   :help, :?                   display this list of commands\n" ++
  "   :info [<name> ...]          display information about the given names\n" ++
  "   :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" ++
+ "   :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" ++
+ "   :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"++
+ "   :sprint [<name> ...]        simplifed version of :print\n" ++
+
+ "\n" ++
+ " -- Commands for changing settings:\n" ++
  "\n" ++
  "   :set <option> ...           set options\n" ++
  "   :set args <arg> ...         set the arguments returned by System.getArgs\n" ++
@@ -181,29 +199,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" ++
- "\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" ++
- "   :!<command>                 run the shell command <command>\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" ++
+ " -- 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" 
--- Todo: add help for breakpoint commands here
 
 findEditor = do
   getEnv "EDITOR" 
@@ -539,7 +552,7 @@ runStmt stmt step
       result <- io $ withProgName (progname st) $ withArgs (args st) $
 	     	     GHC.runStmt session stmt step
       afterRunStmt result
-      return False
+      return (isRunResultOk result)
 
 
 afterRunStmt :: GHC.RunResult -> GHCi (Maybe (Bool,[Name]))
@@ -583,6 +596,11 @@ switchOnRunResult (GHC.RunBreak threadId names info) = do
    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)
@@ -1074,8 +1092,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
-
       -- 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
@@ -1113,10 +1133,11 @@ unsetOptions str
 
        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
@@ -1148,14 +1169,20 @@ optToStr RevertCAFs = "r"
 -- ---------------------------------------------------------------------------
 -- code for `:show'
 
-showCmd str =
+showCmd str = do
+  st <- getGHCiState
   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
-        ["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
@@ -1479,15 +1506,23 @@ deleteCmd argLine = do
          | otherwise = return ()
 
 historyCmd :: String -> GHCi ()
-historyCmd = noArgs $ 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
-      spans <- mapM (io . GHC.getHistorySpan s) hist
-      printForUser (vcat (map ppr spans))
+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
@@ -1758,7 +1793,7 @@ mkTickArray ticks
         [ (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 ]