Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : ghc-7.2

http://hackage.haskell.org/trac/ghc/changeset/abe692e21d6c3bd2bb9675414f488c15cae8c534

>---------------------------------------------------------------

commit abe692e21d6c3bd2bb9675414f488c15cae8c534
Author: Simon Marlow <[email protected]>
Date:   Tue Jul 12 10:40:50 2011 +0100

    Debugger commands do not work with -fno-ghci-sandbox, so emit useful
    error messages.

>---------------------------------------------------------------

 ghc/InteractiveUI.hs |   77 ++++++++++++++++++++++++++++++--------------------
 1 files changed, 46 insertions(+), 31 deletions(-)

diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
index 139c2b4..5b44097 100644
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -897,6 +897,14 @@ noArgs :: GHCi () -> String -> GHCi ()
 noArgs m "" = m
 noArgs _ _  = liftIO $ putStrLn "This command takes no arguments"
 
+withSandboxOnly :: String -> GHCi () -> GHCi ()
+withSandboxOnly cmd this = do
+   dflags <- getDynFlags
+   if not (dopt Opt_GhciSandbox dflags)
+      then printForUser (text cmd <+>
+                         ptext (sLit "is not supported with 
-fno-ghci-sandbox"))
+      else this
+
 help :: String -> GHCi ()
 help _ = liftIO (putStr helpText)
 
@@ -2086,32 +2094,37 @@ pprintCommand bind force str = do
   pprintClosureCommand bind force str
 
 stepCmd :: String -> GHCi ()
-stepCmd []         = doContinue (const True) GHC.SingleStep
-stepCmd expression = runStmt expression GHC.SingleStep >> return ()
+stepCmd arg = withSandboxOnly ":step" $ step arg
+  where
+  step []         = doContinue (const True) GHC.SingleStep
+  step expression = runStmt expression GHC.SingleStep >> return ()
 
 stepLocalCmd :: String -> GHCi ()
-stepLocalCmd  [] = do 
-  mb_span <- getCurrentBreakSpan
-  case mb_span of
-    Nothing  -> stepCmd []
-    Just loc -> do
-       Just mod <- getCurrentBreakModule
-       current_toplevel_decl <- enclosingTickSpan mod loc
-       doContinue (`isSubspanOf` current_toplevel_decl) GHC.SingleStep
-
-stepLocalCmd expression = stepCmd expression
+stepLocalCmd arg = withSandboxOnly ":steplocal" $ step arg
+  where
+  step expr
+   | not (null expr) = stepCmd expr
+   | otherwise = do
+      mb_span <- getCurrentBreakSpan
+      case mb_span of
+        Nothing  -> stepCmd []
+        Just loc -> do
+           Just mod <- getCurrentBreakModule
+           current_toplevel_decl <- enclosingTickSpan mod loc
+           doContinue (`isSubspanOf` current_toplevel_decl) GHC.SingleStep
 
 stepModuleCmd :: String -> GHCi ()
-stepModuleCmd  [] = do 
-  mb_span <- getCurrentBreakSpan
-  case mb_span of
-    Nothing  -> stepCmd []
-    Just _ -> do
-       Just span <- getCurrentBreakSpan
-       let f some_span = srcSpanFileName_maybe span == srcSpanFileName_maybe 
some_span
-       doContinue f GHC.SingleStep
-
-stepModuleCmd expression = stepCmd expression
+stepModuleCmd arg = withSandboxOnly ":stepmodule" $ step arg
+  where
+  step expr
+   | not (null expr) = stepCmd expr
+   | otherwise = do
+      mb_span <- getCurrentBreakSpan
+      case mb_span of
+        Nothing  -> stepCmd []
+        Just span -> do
+           let f some_span = srcSpanFileName_maybe span == 
srcSpanFileName_maybe some_span
+           doContinue f GHC.SingleStep
 
 -- | Returns the span of the largest tick containing the srcspan given
 enclosingTickSpan :: Module -> SrcSpan -> GHCi SrcSpan
@@ -2127,11 +2140,14 @@ enclosingTickSpan mod (RealSrcSpan src) = do
   return . head . sortBy leftmost_largest $ enclosing_spans
 
 traceCmd :: String -> GHCi ()
-traceCmd []         = doContinue (const True) GHC.RunAndLogSteps
-traceCmd expression = runStmt expression GHC.RunAndLogSteps >> return ()
+traceCmd arg
+  = withSandboxOnly ":trace" $ trace arg
+  where
+  trace []         = doContinue (const True) GHC.RunAndLogSteps
+  trace expression = runStmt expression GHC.RunAndLogSteps >> return ()
 
 continueCmd :: String -> GHCi ()
-continueCmd = noArgs $ doContinue (const True) GHC.RunToCompletion
+continueCmd = noArgs $ withSandboxOnly ":continue" $ doContinue (const True) 
GHC.RunToCompletion
 
 -- doContinue :: SingleStep -> GHCi ()
 doContinue :: (SrcSpan -> Bool) -> SingleStep -> GHCi ()
@@ -2141,12 +2157,12 @@ doContinue pred step = do
   return ()
 
 abandonCmd :: String -> GHCi ()
-abandonCmd = noArgs $ do
+abandonCmd = noArgs $ withSandboxOnly ":abandon" $ do
   b <- GHC.abandon -- the prompt will change to indicate the new context
   when (not b) $ liftIO $ putStrLn "There is no computation running."
 
 deleteCmd :: String -> GHCi ()
-deleteCmd argLine = do
+deleteCmd argLine = withSandboxOnly ":delete" $ do
    deleteSwitch $ words argLine
    where
    deleteSwitch :: [String] -> GHCi ()
@@ -2194,7 +2210,7 @@ bold c | do_bold   = text start_bold <> c <> text end_bold
        | otherwise = c
 
 backCmd :: String -> GHCi ()
-backCmd = noArgs $ do
+backCmd = noArgs $ withSandboxOnly ":back" $ do
   (names, _, span) <- GHC.back
   printForUser $ ptext (sLit "Logged breakpoint at") <+> ppr span
   printTypeOfNames names
@@ -2203,7 +2219,7 @@ backCmd = noArgs $ do
   enqueueCommands [stop st]
 
 forwardCmd :: String -> GHCi ()
-forwardCmd = noArgs $ do
+forwardCmd = noArgs $ withSandboxOnly ":forward" $ do
   (names, ix, span) <- GHC.forward
   printForUser $ (if (ix == 0)
                     then ptext (sLit "Stopped at")
@@ -2215,8 +2231,7 @@ forwardCmd = noArgs $ do
 
 -- handle the "break" command
 breakCmd :: String -> GHCi ()
-breakCmd argLine = do
-   breakSwitch $ words argLine
+breakCmd argLine = withSandboxOnly ":break" $ breakSwitch $ words argLine
 
 breakSwitch :: [String] -> GHCi ()
 breakSwitch [] = do



_______________________________________________
Cvs-ghc mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/cvs-ghc

Reply via email to