X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FInteractiveUI.hs;h=4d7658ec93f82693a0744bec4eb06bc601b664e7;hb=f3e5a3add2e8b5f878be96d7b04ef52e3c39a211;hp=8066aa4c082c350d078462ed541592c8ff3fd99e;hpb=c5f6a3c65987b467cb64be30abd7a10ea6280b67;p=ghc-hetmet.git

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index 8066aa4..4d7658e 100644
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -15,13 +15,13 @@ module InteractiveUI (
 
 import GhciMonad
 import GhciTags
+import Debugger
 
 -- The GHC interface
 import qualified GHC
 import GHC              ( Session, LoadHowMuch(..), Target(..),  TargetId(..),
                           Type, Module, ModuleName, TyThing(..), Phase,
                           BreakIndex, Name, SrcSpan )
-import Debugger
 import DynFlags
 import Packages
 import PackageConfig
@@ -102,6 +102,7 @@ builtin_commands = [
 	-- Hugs users are accustomed to :e, so make sure it doesn't overlap
   ("?",		keepGoing help,			False, completeNone),
   ("add",	keepGoingPaths addModule,	False, completeFilename),
+  ("abandon",   keepGoing abandonCmd,           False, completeNone),
   ("break",     keepGoing breakCmd,             False, completeIdentifier),
   ("browse",    keepGoing browseCmd,		False, completeModule),
   ("cd",    	keepGoing changeDirectory,	False, completeFilename),
@@ -113,7 +114,7 @@ builtin_commands = [
   ("e", 	keepGoing editFile,		False, completeFilename),
   ("edit",	keepGoing editFile,		False, completeFilename),
   ("etags",	keepGoing createETagsFileCmd,	False, completeFilename),
-  ("force",     keepGoing (pprintClosureCommand False True), False, completeIdentifier),
+  ("force",     keepGoing forceCmd,             False, completeIdentifier),
   ("help",	keepGoing help,			False, completeNone),
   ("info",      keepGoing info,			False, completeIdentifier),
   ("kind",	keepGoing kindOfType,		False, completeIdentifier),
@@ -121,12 +122,12 @@ builtin_commands = [
   ("list",	keepGoing listCmd,              False, completeNone),
   ("module",	keepGoing setContext,		False, completeModule),
   ("main",	keepGoing runMain,		False, completeIdentifier),
-  ("print",     keepGoing (pprintClosureCommand True False), False, completeIdentifier),
+  ("print",     keepGoing printCmd,             False, completeIdentifier),
   ("quit",	quit,				False, completeNone),
   ("reload", 	keepGoing reloadModule,  	False, completeNone),
   ("set",	keepGoing setCmd,		True,  completeSetOptions),
   ("show",	keepGoing showCmd,		False, completeNone),
-  ("sprint",    keepGoing (pprintClosureCommand False False),False, completeIdentifier),
+  ("sprint",    keepGoing sprintCmd,            False, completeIdentifier),
   ("step",      stepCmd,                        False, completeIdentifier), 
   ("type",	keepGoing typeOfExpr,		False, completeIdentifier),
   ("undef",     keepGoing undefineMacro,	False, completeMacro),
@@ -146,6 +147,7 @@ helpText =
  "\n" ++
  "   <stmt>                      evaluate/run <stmt>\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" ++
@@ -1354,6 +1356,14 @@ setUpConsole = do
 -- -----------------------------------------------------------------------------
 -- commands for debugger
 
+sprintCmd = pprintCommand False False
+printCmd  = pprintCommand True False
+forceCmd  = pprintCommand False True
+
+pprintCommand bind force str = do
+  session <- getSession
+  io $ pprintClosureCommand session bind force str
+
 foreign import ccall "rts_setStepFlag" setStepFlag :: IO () 
 
 stepCmd :: String -> GHCi Bool
@@ -1383,6 +1393,16 @@ doContinue actionBeforeCont = do
          finishEvalExpr names
          return False
 
+abandonCmd :: String -> GHCi ()
+abandonCmd "" = do
+   mb_res <- popResume
+   case mb_res of
+      Nothing -> do 
+         io $ putStrLn "There is no computation running."
+      Just (span,_,_) ->
+         return ()
+         -- the prompt will change to indicate the new context
+
 deleteCmd :: String -> GHCi ()
 deleteCmd argLine = do
    deleteSwitch $ words argLine