X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FInteractiveUI.hs;h=3e528d00302729721661e16e81c3faa2ab8a0242;hb=6d075f13b503ad7b1255911e98f4837a08607ed7;hp=a1aaa6ac00b7a97975326b1439a8904ba08d5f34;hpb=3a0ddd1f757d1c44c98227f2b2587f1b1949c897;p=ghc-hetmet.git

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index a1aaa6a..3e528d0 100644
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -79,17 +79,12 @@ import Control.Monad as Monad
 
 import Foreign.StablePtr	( newStablePtr )
 import GHC.Exts		( unsafeCoerce# )
-import GHC.IOBase	( IOErrorType(InvalidArgument), IO(IO) )
+import GHC.IOBase	( IOErrorType(InvalidArgument) )
 
 import Data.IORef	( IORef, readIORef, writeIORef )
 
 import System.Posix.Internals ( setNonBlockingFD )
 
--- these are needed by the new ghci debugger
-import ByteCodeLink (HValue)
-import ByteCodeInstr (BreakInfo (..))
-import BreakArray
-
 -----------------------------------------------------------------------------
 
 ghciWelcomeMsg =
@@ -109,14 +104,14 @@ builtin_commands = [
 	-- Hugs users are accustomed to :e, so make sure it doesn't overlap
   ("?",		keepGoing help,			False, completeNone),
   ("add",	keepGoingPaths addModule,	False, completeFilename),
-  ("break",     breakCmd, False, completeNone),   
+  ("break",     breakCmd,                       False, completeIdentifier),
   ("browse",    keepGoing browseCmd,		False, completeModule),
   ("cd",    	keepGoing changeDirectory,	False, completeFilename),
   ("check",	keepGoing checkModule,		False, completeHomeModule),
-  ("continue",  continueCmd, False, completeNone),
+  ("continue",  continueCmd,                    False, completeNone),
   ("ctags",	keepGoing createCTagsFileCmd, 	False, completeFilename),
   ("def",	keepGoing defineMacro,		False, completeIdentifier),
-  ("delete",    deleteCmd, False, completeNone),   
+  ("delete",    deleteCmd,                      False, completeNone),
   ("e", 	keepGoing editFile,		False, completeFilename),
   ("edit",	keepGoing editFile,		False, completeFilename),
   ("etags",	keepGoing createETagsFileCmd,	False, completeFilename),
@@ -124,7 +119,7 @@ builtin_commands = [
   ("help",	keepGoing help,			False, completeNone),
   ("info",      keepGoing info,			False, completeIdentifier),
   ("kind",	keepGoing kindOfType,		False, completeIdentifier),
-  ("load",	keepGoingPaths loadModule_,False, completeHomeModuleOrFile),
+  ("load",	keepGoingPaths loadModule_,     False, completeHomeModuleOrFile),
   ("module",	keepGoing setContext,		False, completeModule),
   ("main",	keepGoing runMain,		False, completeIdentifier),
   ("print",     keepGoing (pprintClosureCommand True False), False, completeIdentifier),
@@ -133,7 +128,7 @@ builtin_commands = [
   ("set",	keepGoing setCmd,		True,  completeSetOptions),
   ("show",	keepGoing showCmd,		False, completeNone),
   ("sprint",    keepGoing (pprintClosureCommand False False),False, completeIdentifier),
-  ("step",      stepCmd, False, completeNone), 
+  ("step",      stepCmd,                        False, completeIdentifier), 
   ("type",	keepGoing typeOfExpr,		False, completeIdentifier),
   ("undef",     keepGoing undefineMacro,	False, completeMacro),
   ("unset",	keepGoing unsetOptions,		True,  completeSetOptions)
@@ -147,24 +142,32 @@ keepGoingPaths a str = a (toArgs str) >> return False
 
 shortHelpText = "use :? for help.\n"
 
--- NOTE: spaces at the end of each line to workaround CPP/string gap bug.
 helpText =
  " Commands available from the prompt:\n" ++
  "\n" ++
  "   <stmt>                      evaluate/run <stmt>\n" ++
  "   :add <filename> ...         add module(s) to the current target set\n" ++
+ "   :break [<mod>] <l> [<col>]  set a breakpoint at the specified location\n" ++
+ "   :break <name>               set a breakpoint on the specified function\n" ++
  "   :browse [*]<module>         display the names defined by <module>\n" ++
  "   :cd <dir>                   change directory to <dir>\n" ++
+ "   :continue                   resume after a breakpoint\n" ++
+ "   :ctags [<file>]             create tags file for Vi (default: \"tags\")\n" ++
  "   :def <cmd> <expr>           define a command :<cmd>\n" ++
+ "   :delete <number>            delete the specified breakpoint\n" ++
+ "   :delete *                   delete all breakpoints\n" ++
  "   :edit <file>                edit file\n" ++
  "   :edit                       edit last module\n" ++
+ "   :etags [<file>]             create tags file for Emacs (default: \"TAGS\")\n" ++
+-- "   :force <expr>               print <expr>, forcing unevaluated parts\n" ++
  "   :help, :?                   display this list of commands\n" ++
  "   :info [<name> ...]          display information about the given names\n" ++
- "   :print [<name> ...]         prints a value without forcing its computation\n" ++
- "   :sprint [<name> ...]        simplified version of :print\n" ++
+ "   :kind <type>                show the kind of <type>\n" ++
  "   :load <filename> ...        load module(s) and their dependents\n" ++
  "   :module [+/-] [*]<mod> ...  set the context for expression evaluation\n" ++
  "   :main [<arguments> ...]     run the main function with the given arguments\n" ++
+ "   :print [<name> ...]         prints a value without forcing its computation\n" ++
+ "   :quit                       exit GHCi\n" ++
  "   :reload                     reload the current module set\n" ++
  "\n" ++
  "   :set <option> ...           set options\n" ++
@@ -173,16 +176,17 @@ helpText =
  "   :set prompt <prompt>        set the prompt used in GHCi\n" ++
  "   :set editor <cmd>           set the command used for :edit\n" ++
  "\n" ++
+ "   :show breaks                show active breakpoints\n" ++
+ "   :show context               show the breakpoint context\n" ++
  "   :show modules               show the currently loaded modules\n" ++
  "   :show bindings              show the current bindings made at the prompt\n" ++
  "\n" ++
- "   :ctags [<file>]             create tags file for Vi (default: \"tags\")\n" ++
- "   :etags [<file>]             create tags file for Emacs (default: \"TAGS\")\n" ++
+ "   :sprint [<name> ...]        simplifed version of :print\n" ++
+ "   :step                       single-step after stopping at a breakpoint\n"++
+ "   :step <expr>                single-step into <expr>\n"++
  "   :type <expr>                show the type of <expr>\n" ++
- "   :kind <type>                show the kind of <type>\n" ++
  "   :undef <cmd>                undefine user-defined command :<cmd>\n" ++
  "   :unset <option> ...         unset options\n" ++
- "   :quit                       exit GHCi\n" ++
  "   :!<command>                 run the shell command <command>\n" ++
  "\n" ++
  " Options for ':set' and ':unset':\n" ++
@@ -1200,7 +1204,8 @@ showCmd str =
 	["bindings"] -> showBindings
 	["linker"]   -> io showLinkerState
         ["breaks"] -> showBkptTable
-	_ -> throwDyn (CmdLineError "syntax:  :show [modules|bindings]")
+        ["context"] -> showContext
+	_ -> throwDyn (CmdLineError "syntax:  :show [modules|bindings|breaks]")
 
 showModules = do
   session <- getSession
@@ -1234,6 +1239,13 @@ showBkptTable = do
    activeBreaks <- getActiveBreakPoints 
    printForUser $ ppr activeBreaks 
 
+showContext :: GHCi ()
+showContext = do
+   st <- getGHCiState
+   printForUser $ vcat (map pp_resume (resume st))
+  where
+   pp_resume (span, _, _) = ptext SLIT("Stopped at") <+> ppr span
+
 -- -----------------------------------------------------------------------------
 -- Completion
 
@@ -1487,29 +1499,43 @@ breakCmd :: String -> GHCi Bool
 breakCmd argLine = do
    session <- getSession
    breakSwitch session $ words argLine
+   return False
 
-breakSwitch :: Session -> [String] -> GHCi Bool
+breakSwitch :: Session -> [String] -> GHCi ()
 breakSwitch _session [] = do
    io $ putStrLn "The break command requires at least one argument."
-   return False
 breakSwitch session args@(arg1:rest) 
-   | looksLikeModule arg1 = do
+   | looksLikeModuleName arg1 = do
         mod <- wantInterpretedModule session arg1
-        breakByModule mod rest
-        return False
-   | otherwise = do
+        breakByModule session mod rest
+   | all isDigit arg1 = do
         (toplevel, _) <- io $ GHC.getContext session 
         case toplevel of
-           (mod : _) -> breakByModule mod args 
+           (mod : _) -> breakByModuleLine mod (read arg1) rest
            [] -> do 
               io $ putStrLn "Cannot find default module for breakpoint." 
               io $ putStrLn "Perhaps no modules are loaded for debugging?"
-        return False
-   where
-   -- Todo there may be a nicer way to test this
-   looksLikeModule :: String -> Bool
-   looksLikeModule []    = False
-   looksLikeModule (x:_) = isUpper x
+   | otherwise = do -- assume it's a name
+        names <- io $ GHC.parseName session arg1
+        case names of
+          []    -> return ()
+          (n:_) -> do
+            let loc  = nameSrcLoc n
+                modl = nameModule n
+            is_interpreted <- io (GHC.moduleIsInterpreted session modl)
+            if not is_interpreted
+               then noCanDo $ text "module " <> ppr modl <>
+                              text " is not interpreted"
+               else do
+            if isGoodSrcLoc loc
+               then findBreakAndSet (nameModule n) $ 
+                         findBreakByCoord (srcLocLine loc, srcLocCol loc)
+               else noCanDo $ text "can't find its location: " <>
+                              ppr loc
+           where
+             noCanDo why = printForUser $
+                text "cannot set breakpoint on " <> ppr n <> text ": " <> why
+
 
 wantInterpretedModule :: Session -> String -> GHCi Module
 wantInterpretedModule session str = do
@@ -1519,26 +1545,18 @@ wantInterpretedModule session str = do
        throwDyn (CmdLineError ("module '" ++ str ++ "' is not interpreted"))
    return modl
 
-breakByModule :: Module -> [String] -> GHCi () 
-breakByModule mod args@(arg1:rest)
+breakByModule :: Session -> Module -> [String] -> GHCi () 
+breakByModule session mod args@(arg1:rest)
    | all isDigit arg1 = do  -- looks like a line number
         breakByModuleLine mod (read arg1) rest
-   | looksLikeVar arg1 = do
-        -- break by a function definition
-        io $ putStrLn "Break by function definition not implemented."
-   | otherwise = io $ putStrLn "Invalid arguments to break command."
-   where
-   -- Todo there may be a nicer way to test this
-   looksLikeVar :: String -> Bool
-   looksLikeVar [] = False
-   looksLikeVar (x:_) = isLower x || x `elem` "~!@#$%^&*-+"
+   | otherwise = io $ putStrLn "Invalid arguments to :break"
 
 breakByModuleLine :: Module -> Int -> [String] -> GHCi ()
 breakByModuleLine mod line args
    | [] <- args = findBreakAndSet mod $ findBreakByLine line
    | [col] <- args, all isDigit col =
         findBreakAndSet mod $ findBreakByCoord (line, read col)
-   | otherwise = io $ putStrLn "Invalid arguments to break command."
+   | otherwise = io $ putStrLn "Invalid arguments to :break"
 
 findBreakAndSet :: Module -> (TickArray -> Maybe (Int, SrcSpan)) -> GHCi ()
 findBreakAndSet mod lookupTickTree = do 
@@ -1573,10 +1591,12 @@ findBreakAndSet mod lookupTickTree = do
 --    - the rightmost subexpression enclosing the specified line
 --
 findBreakByLine :: Int -> TickArray -> Maybe (BreakIndex,SrcSpan)
-findBreakByLine line arr = 
-  listToMaybe (sortBy leftmost complete)   `mplus`
-  listToMaybe (sortBy leftmost incomplete) `mplus`
-  listToMaybe (sortBy rightmost ticks)
+findBreakByLine line arr
+  | not (inRange (bounds arr) line) = Nothing
+  | otherwise =
+    listToMaybe (sortBy leftmost complete)   `mplus`
+    listToMaybe (sortBy leftmost incomplete) `mplus`
+    listToMaybe (sortBy rightmost ticks)
   where 
         ticks = arr ! line
 
@@ -1587,8 +1607,10 @@ findBreakByLine line arr =
             where ends_here (nm,span) = srcSpanEndLine span == line
 
 findBreakByCoord :: (Int,Int) -> TickArray -> Maybe (BreakIndex,SrcSpan)
-findBreakByCoord (line, col) arr =
-  listToMaybe (sortBy rightmost contains)
+findBreakByCoord (line, col) arr
+  | not (inRange (bounds arr) line) = Nothing
+  | otherwise =
+    listToMaybe (sortBy rightmost contains)
   where 
         ticks = arr ! line
 
@@ -1632,7 +1654,7 @@ mkTickArray ticks
         max_line = maximum (map srcSpanEndLine (map snd ticks))
         srcSpanLines span = [ srcSpanStartLine span .. srcSpanEndLine span ]
 
-getModBreak :: Module -> GHCi (BreakArray, Array Int SrcSpan)
+getModBreak :: Module -> GHCi (GHC.BreakArray, Array Int SrcSpan)
 getModBreak mod = do
    session <- getSession
    Just mod_info <- io $ GHC.getModuleInfo session mod
@@ -1645,10 +1667,10 @@ lookupModule :: Session -> String -> GHCi Module
 lookupModule session modName
    = io (GHC.findModule session (GHC.mkModuleName modName) Nothing)
 
-setBreakFlag :: Bool -> BreakArray -> Int -> IO Bool 
+setBreakFlag :: Bool -> GHC.BreakArray -> Int -> IO Bool 
 setBreakFlag toggle array index
-   | toggle    = setBreakOn array index 
-   | otherwise = setBreakOff array index
+   | toggle    = GHC.setBreakOn array index 
+   | otherwise = GHC.setBreakOff array index
 
 
 {- these should probably go to the GHC API at some point -}