X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FInteractiveUI.hs;h=28854650b78e5d330f913f06c5819422fdc1cc43;hb=cf48cf640cc96fc0cb50b5c683cf16bbede064a0;hp=ddd6a139e37f5749f8a0a171a3eb83f63c3f542b;hpb=0855975c5e81b1ef9a7871a436af3f34c55dfd87;p=ghc-hetmet.git

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index ddd6a13..2885465 100644
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -79,7 +79,7 @@ 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 )
 
@@ -109,14 +109,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 +124,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 +133,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)
@@ -1495,29 +1495,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
@@ -1527,26 +1541,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