[commit: ghc] master: GHCi: use real time instead of CPU time for :set -s (95f9334)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/95f9334aeeebc8708ed89a5d985b6be3e8a3f1da/ghc

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

commit 95f9334aeeebc8708ed89a5d985b6be3e8a3f1da
Author: Simon Marlow <marlowsd at gmail.com>
Date:   Fri Apr 15 16:21:56 2016 -0700

    GHCi: use real time instead of CPU time for :set -s
    
    CPU time is never very accurate, and it broke completely with
    -fexternal-interpreter which runs the interpreted computations in a
    separate process.


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

95f9334aeeebc8708ed89a5d985b6be3e8a3f1da
 ghc/GHCi/UI/Monad.hs | 16 ++++++++--------
 1 file changed, 8 insertions(+), 8 deletions(-)

diff --git a/ghc/GHCi/UI/Monad.hs b/ghc/GHCi/UI/Monad.hs
index 824bba1..306fa21 100644
--- a/ghc/GHCi/UI/Monad.hs
+++ b/ghc/GHCi/UI/Monad.hs
@@ -48,7 +48,7 @@ import Exception
 import Numeric
 import Data.Array
 import Data.IORef
-import System.CPUTime
+import Data.Time
 import System.Environment
 import System.IO
 import Control.Monad
@@ -348,18 +348,18 @@ timeIt getAllocs action
   = do b <- lift $ isOptionSet ShowTiming
        if not b
           then action
-          else do time1   <- liftIO $ getCPUTime
+          else do time1   <- liftIO $ getCurrentTime
                   a <- action
                   let allocs = getAllocs a
-                  time2   <- liftIO $ getCPUTime
+                  time2   <- liftIO $ getCurrentTime
                   dflags  <- getDynFlags
-                  liftIO $ printTimes dflags allocs (time2 - time1)
+                  let period = time2 `diffUTCTime` time1
+                  liftIO $ printTimes dflags allocs (realToFrac period)
                   return a
 
-printTimes :: DynFlags -> Maybe Integer -> Integer -> IO ()
-printTimes dflags mallocs psecs
-   = do let secs = (fromIntegral psecs / (10^(12::Integer))) :: Float
-            secs_str = showFFloat (Just 2) secs
+printTimes :: DynFlags -> Maybe Integer -> Double -> IO ()
+printTimes dflags mallocs secs
+   = do let secs_str = showFFloat (Just 2) secs
         putStrLn (showSDoc dflags (
                  parens (text (secs_str "") <+> text "secs" <> comma <+>
                          case mallocs of