refactoring only

[ghc-hetmet.git] / compiler / ghci / InteractiveUI.hs

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index 5f9f74f..3de1c7b 100644 (file)
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -109,7 +109,7 @@ builtin_commands = [
   ("browse",    keepGoing browseCmd,           False, completeModule),
   ("cd",       keepGoing changeDirectory,      False, completeFilename),
   ("check",    keepGoing checkModule,          False, completeHomeModule),
   ("browse",    keepGoing browseCmd,           False, completeModule),
   ("cd",       keepGoing changeDirectory,      False, completeFilename),
   ("check",    keepGoing checkModule,          False, completeHomeModule),

-  ("continue",  continueCmd,                    False, completeNone),
+  ("continue",  keepGoing continueCmd,          False, completeNone),

   ("ctags",    keepGoing createCTagsFileCmd,   False, completeFilename),
   ("def",      keepGoing defineMacro,          False, completeIdentifier),
   ("delete",    keepGoing deleteCmd,            False, completeNone),
   ("ctags",    keepGoing createCTagsFileCmd,   False, completeFilename),
   ("def",      keepGoing defineMacro,          False, completeIdentifier),
   ("delete",    keepGoing deleteCmd,            False, completeNone),

@@ -132,9 +132,9 @@ builtin_commands = [
   ("set",      keepGoing setCmd,               True,  completeSetOptions),
   ("show",     keepGoing showCmd,              False, completeNone),
   ("sprint",    keepGoing sprintCmd,            False, completeIdentifier),
   ("set",      keepGoing setCmd,               True,  completeSetOptions),
   ("show",     keepGoing showCmd,              False, completeNone),
   ("sprint",    keepGoing sprintCmd,            False, completeIdentifier),

-  ("step",      stepCmd,                        False, completeIdentifier), 
+  ("step",      keepGoing stepCmd,              False, completeIdentifier), 

   ("type",     keepGoing typeOfExpr,           False, completeIdentifier),
   ("type",     keepGoing typeOfExpr,           False, completeIdentifier),

-  ("trace",     traceCmd,                       False, completeIdentifier), 
+  ("trace",     keepGoing traceCmd,             False, completeIdentifier), 

   ("undef",     keepGoing undefineMacro,       False, completeMacro),
   ("unset",    keepGoing unsetOptions,         True,  completeSetOptions)
   ]
   ("undef",     keepGoing undefineMacro,       False, completeMacro),
   ("unset",    keepGoing unsetOptions,         True,  completeSetOptions)
   ]

@@ -552,53 +552,34 @@ runStmt stmt step
       result <- io $ withProgName (progname st) $ withArgs (args st) $
                     GHC.runStmt session stmt step
       afterRunStmt result
       result <- io $ withProgName (progname st) $ withArgs (args st) $
                     GHC.runStmt session stmt step
       afterRunStmt result

-      return (isRunResultOk result)

 
 
 
 

-afterRunStmt :: GHC.RunResult -> GHCi (Maybe (Bool,[Name]))
+afterRunStmt :: GHC.RunResult -> GHCi Bool
+                                 -- False <=> the statement failed to compile
+afterRunStmt (GHC.RunException e) = throw e

 afterRunStmt run_result = do
 afterRunStmt run_result = do

-  mb_result <- switchOnRunResult run_result
-  -- possibly print the type and revert CAFs after evaluating an expression
-  show_types <- isOptionSet ShowType

   session <- getSession
   session <- getSession

-  case mb_result of
-    Nothing    -> return ()      
-    Just (is_break,names) -> 
-            when (is_break || show_types) $
-                  mapM_ (showTypeOfName session) names
-  
+  case run_result of
+     GHC.RunOk names -> do
+        show_types <- isOptionSet ShowType
+        when show_types $ mapM_ (showTypeOfName session) names
+     GHC.RunBreak _ names _ -> do
+        resumes <- io $ GHC.getResumeContext session
+        printForUser $ ptext SLIT("Stopped at") <+> 
+                       ppr (GHC.resumeSpan (head resumes))
+        mapM_ (showTypeOfName session) names
+        -- run the command set with ":set stop <cmd>"
+        st <- getGHCiState
+        runCommand (stop st)
+        return ()
+     _ -> return ()
+

   flushInterpBuffers
   io installSignalHandlers
   b <- isOptionSet RevertCAFs
   io (when b revertCAFs)
 
   flushInterpBuffers
   io installSignalHandlers
   b <- isOptionSet RevertCAFs
   io (when b revertCAFs)
 

-  return mb_result
-
-
-switchOnRunResult :: GHC.RunResult -> GHCi (Maybe (Bool,[Name]))
-switchOnRunResult GHC.RunFailed = return Nothing
-switchOnRunResult (GHC.RunException e) = throw e
-switchOnRunResult (GHC.RunOk names) = return $ Just (False,names)
-switchOnRunResult (GHC.RunBreak threadId names info) = do
-   session <- getSession
-   Just mod_info <- io $ GHC.getModuleInfo session (GHC.breakInfo_module info) 
-   let modBreaks  = GHC.modInfoModBreaks mod_info
-   let ticks      = GHC.modBreaks_locs modBreaks
-
-   -- display information about the breakpoint
-   let location = ticks ! GHC.breakInfo_number info
-   printForUser $ ptext SLIT("Stopped at") <+> ppr location
-
-   -- run the command set with ":set stop <cmd>"
-   st <- getGHCiState
-   runCommand (stop st)
-
-   return (Just (True,names))
-
-
-isRunResultOk :: GHC.RunResult -> Bool
-isRunResultOk (GHC.RunOk _) = True
-isRunResultOk _             = False
+  return (case run_result of GHC.RunOk _ -> True; _ -> False)

 
 
 showTypeOfName :: Session -> Name -> GHCi ()
 
 
 showTypeOfName :: Session -> Name -> GHCi ()

@@ -794,6 +775,7 @@ loadModule' files = do
   session <- getSession
 
   -- unload first
   session <- getSession
 
   -- unload first

+  discardActiveBreakPoints

   io (GHC.setTargets session [])
   io (GHC.load session LoadAllTargets)
 
   io (GHC.setTargets session [])
   io (GHC.load session LoadAllTargets)
 

@@ -809,9 +791,7 @@ loadModule' files = do
   -- as a ToDo for now.
 
   io (GHC.setTargets session targets)
   -- as a ToDo for now.
 
   io (GHC.setTargets session targets)

-  ok <- io (GHC.load session LoadAllTargets)
-  afterLoad ok session
-  return ok
+  doLoad session LoadAllTargets

 
 checkModule :: String -> GHCi ()
 checkModule m = do
 
 checkModule :: String -> GHCi ()
 checkModule m = do

@@ -834,19 +814,28 @@ checkModule m = do
 reloadModule :: String -> GHCi ()
 reloadModule "" = do
   io (revertCAFs)              -- always revert CAFs on reload.
 reloadModule :: String -> GHCi ()
 reloadModule "" = do
   io (revertCAFs)              -- always revert CAFs on reload.

+  discardActiveBreakPoints

   session <- getSession
   session <- getSession

-  ok <- io (GHC.load session LoadAllTargets)
-  afterLoad ok session
+  doLoad session LoadAllTargets
+  return ()

 reloadModule m = do
   io (revertCAFs)              -- always revert CAFs on reload.
 reloadModule m = do
   io (revertCAFs)              -- always revert CAFs on reload.

+  discardActiveBreakPoints

   session <- getSession
   session <- getSession

-  ok <- io (GHC.load session (LoadUpTo (GHC.mkModuleName m)))
+  doLoad session (LoadUpTo (GHC.mkModuleName m))
+  return ()
+
+doLoad session howmuch = do
+  -- turn off breakpoints before we load: we can't turn them off later, because
+  -- the ModBreaks will have gone away.
+  discardActiveBreakPoints
+  ok <- io (GHC.load session howmuch)

   afterLoad ok session
   afterLoad ok session

+  return ok

 
 afterLoad ok session = do
   io (revertCAFs)  -- always revert CAFs on load.
   discardTickArrays
 
 afterLoad ok session = do
   io (revertCAFs)  -- always revert CAFs on load.
   discardTickArrays

-  discardActiveBreakPoints

   graph <- io (GHC.getModuleGraph session)
   graph' <- filterM (io . GHC.isLoaded session . GHC.ms_mod_name) graph
   setContextAfterLoad session graph'
   graph <- io (GHC.getModuleGraph session)
   graph' <- filterM (io . GHC.isLoaded session . GHC.ms_mod_name) graph
   setContextAfterLoad session graph'

@@ -1460,26 +1449,23 @@ pprintCommand bind force str = do
   session <- getSession
   io $ pprintClosureCommand session bind force str
 
   session <- getSession
   io $ pprintClosureCommand session bind force str
 

-stepCmd :: String -> GHCi Bool
+stepCmd :: String -> GHCi ()

 stepCmd []         = doContinue GHC.SingleStep
 stepCmd []         = doContinue GHC.SingleStep

-stepCmd expression = runStmt expression GHC.SingleStep
+stepCmd expression = do runStmt expression GHC.SingleStep; return ()

 
 

-traceCmd :: String -> GHCi Bool
+traceCmd :: String -> GHCi ()

 traceCmd []         = doContinue GHC.RunAndLogSteps
 traceCmd []         = doContinue GHC.RunAndLogSteps

-traceCmd expression = runStmt expression GHC.RunAndLogSteps
+traceCmd expression = do runStmt expression GHC.RunAndLogSteps; return ()

 
 

-continueCmd :: String -> GHCi Bool
-continueCmd [] = doContinue GHC.RunToCompletion
-continueCmd other = do
-   io $ putStrLn "The continue command accepts no arguments."
-   return False
+continueCmd :: String -> GHCi ()
+continueCmd = noArgs $ doContinue GHC.RunToCompletion

 
 

-doContinue :: SingleStep -> GHCi Bool
+doContinue :: SingleStep -> GHCi ()

 doContinue step = do 
   session <- getSession
   runResult <- io $ GHC.resume session step
   afterRunStmt runResult
 doContinue step = do 
   session <- getSession
   runResult <- io $ GHC.resume session step
   afterRunStmt runResult

-  return False
+  return ()

 
 abandonCmd :: String -> GHCi ()
 abandonCmd = noArgs $ do
 
 abandonCmd :: String -> GHCi ()
 abandonCmd = noArgs $ do