[commit: ghc] master: Refactor handleRunStatus some more, add comments and tidy up formatting (6f7fa4e)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/6f7fa4e7d9951b5c809f53ec223896b066d01d39/ghc

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

commit 6f7fa4e7d9951b5c809f53ec223896b066d01d39
Author: Simon Marlow <marlowsd at gmail.com>
Date:   Thu Nov 28 12:03:26 2013 +0000

    Refactor handleRunStatus some more, add comments and tidy up formatting
    
    I liked the idea of combining traceRunStatus and handleRunStatus, but
    I think we lost a bit of clarity where traceRunStatus wants to fall
    back to handleRunStatus when the breakpoint is enabled.  So I
    refactored it a bit more.


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

6f7fa4e7d9951b5c809f53ec223896b066d01d39
 compiler/main/InteractiveEval.hs |  118 +++++++++++++++++++++-----------------
 1 file changed, 64 insertions(+), 54 deletions(-)

diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index c0db67a..773dd8d 100644
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -242,64 +242,74 @@ handleRunStatus :: GhcMonad m
 
 handleRunStatus step expr bindings final_ids
                breakMVar statusMVar status history
-  | RunAndLogSteps <- step
-  , Break is_exception apStack info tid <- status
-  , not is_exception
-  =  -- When tracing, if we hit a breakpoint that is not explicitly
-     -- enabled, then we just log the event in the history and continue.
-    do { hsc_env <- getSession
-       ; b <- liftIO $ isBreakEnabled hsc_env info
-       ; if b
-           then handleRunStatus RunToCompletion expr bindings final_ids
-                                breakMVar statusMVar status history
-           else
-    do  { let history' = mkHistory hsc_env apStack info `consBL` history
-                -- probably better make history strict here, otherwise
-                -- our BoundedList will be pointless.
-        ; _ <- liftIO $ evaluate history'
-        ; status <- withBreakAction True (hsc_dflags hsc_env)
-                                    breakMVar statusMVar $ do
-                    liftIO $ mask_ $ do
-                       putMVar breakMVar ()  -- awaken the stopped thread
-                       redirectInterrupts tid $
-                         takeMVar statusMVar   -- and wait for the result
-        ; handleRunStatus RunAndLogSteps expr bindings final_ids
-                          breakMVar statusMVar status history' } }
-
-  | Break is_exception apStack info tid <- status
-  =  -- Did we hit a breakpoint or did we complete?
-    do { hsc_env <- getSession
-       ; let mb_info | is_exception = Nothing
+  | RunAndLogSteps <- step = tracing
+  | otherwise              = not_tracing
+ where
+  tracing
+    | Break is_exception apStack info tid <- status
+    , not is_exception
+    = do
+       hsc_env <- getSession
+       b <- liftIO $ isBreakEnabled hsc_env info
+       if b
+         then not_tracing
+           -- This breakpoint is explicitly enabled; we want to stop
+           -- instead of just logging it.
+         else do
+           let history' = mkHistory hsc_env apStack info `consBL` history
+                 -- probably better make history strict here, otherwise
+                 -- our BoundedList will be pointless.
+           _ <- liftIO $ evaluate history'
+           status <- withBreakAction True (hsc_dflags hsc_env)
+                                     breakMVar statusMVar $ do
+                     liftIO $ mask_ $ do
+                        putMVar breakMVar ()  -- awaken the stopped thread
+                        redirectInterrupts tid $
+                          takeMVar statusMVar   -- and wait for the result
+           handleRunStatus RunAndLogSteps expr bindings final_ids
+                           breakMVar statusMVar status history'
+    | otherwise
+    = not_tracing
+
+  not_tracing
+    -- Hit a breakpoint
+    | Break is_exception apStack info tid <- status
+    = do
+         hsc_env <- getSession
+         let mb_info | is_exception = Nothing
                      | otherwise    = Just info
-       ; (hsc_env1, names, span) <- liftIO $ bindLocalsAtBreakpoint hsc_env apStack
-                                                               mb_info
-       ; let
-            resume = Resume { resumeStmt = expr, resumeThreadId = tid
-                            , resumeBreakMVar = breakMVar, resumeStatMVar = statusMVar
-                            , resumeBindings = bindings, resumeFinalIds = final_ids
-                            , resumeApStack = apStack, resumeBreakInfo = mb_info
-                            , resumeSpan = span, resumeHistory = toListBL history
-                            , resumeHistoryIx = 0 }
-            hsc_env2 = pushResume hsc_env1 resume
-
-        ; modifySession (\_ -> hsc_env2)
-        ; return (RunBreak tid names mb_info) }
-
-  | Complete (Left e) <- status
-  = return (RunException e)
-
-  | Complete (Right hvals) <- status
-  = do { hsc_env <- getSession
-       ; let final_ic = extendInteractiveContext (hsc_IC hsc_env)
+         (hsc_env1, names, span) <- liftIO $
+           bindLocalsAtBreakpoint hsc_env apStack mb_info
+         let
+           resume = Resume
+             { resumeStmt = expr, resumeThreadId = tid
+             , resumeBreakMVar = breakMVar, resumeStatMVar = statusMVar
+             , resumeBindings = bindings, resumeFinalIds = final_ids
+             , resumeApStack = apStack, resumeBreakInfo = mb_info
+             , resumeSpan = span, resumeHistory = toListBL history
+             , resumeHistoryIx = 0 }
+           hsc_env2 = pushResume hsc_env1 resume
+  
+         modifySession (\_ -> hsc_env2)
+         return (RunBreak tid names mb_info)
+  
+    -- Completed with an exception
+    | Complete (Left e) <- status
+    = return (RunException e)
+  
+    -- Completed successfully
+    | Complete (Right hvals) <- status
+    = do hsc_env <- getSession
+         let final_ic = extendInteractiveContext (hsc_IC hsc_env)
                                                  (map AnId final_ids)
              final_names = map getName final_ids
-       ; liftIO $ Linker.extendLinkEnv (zip final_names hvals)
-       ; hsc_env' <- liftIO $ rttiEnvironment hsc_env{hsc_IC=final_ic}
-       ; modifySession (\_ -> hsc_env')
-       ; return (RunOk final_names) }
+         liftIO $ Linker.extendLinkEnv (zip final_names hvals)
+         hsc_env' <- liftIO $ rttiEnvironment hsc_env{hsc_IC=final_ic}
+         modifySession (\_ -> hsc_env')
+         return (RunOk final_names)
   
-  | otherwise
-  = panic "handleRunStatus"  -- The above cases are in fact exhaustive
+    | otherwise
+    = panic "handleRunStatus"  -- The above cases are in fact exhaustive
 
 isBreakEnabled :: HscEnv -> BreakInfo -> IO Bool
 isBreakEnabled hsc_env inf =