Some experiments with how long a deepseq takes

BenchmarkForce.hs

{-# LANGUAGE DeriveGeneric #-}

module Main where

import Control.DeepSeq
import Control.Exception (evaluate)
import Data.Time (diffUTCTime, getCurrentTime)

import GHC.Generics (Generic)
-- import Control.DeepSeq.Generics (genericRnf) -- from deepseq-generics


benchmarkForce :: NFData a => String -> IO a -> IO a
benchmarkForce msg action = do
    before <- getCurrentTime

    -- Force the first time to measure computation + forcing
    result <- evaluate . force =<< action

    after <- getCurrentTime

    -- Force again to see how long forcing itself takes
    _ <- evaluate . force $ result
    
    afterAgain <- getCurrentTime
    putStrLn $ msg ++ ": " ++ show (diffTimeMs before after) ++ " ms"
                   ++ " (force time: " ++ show (diffTimeMs after afterAgain) ++ " ms)"
    return result

    where
        -- Time difference `t2 - t1` in milliseconds
        diffTimeMs t1 t2 = realToFrac (t2 `diffUTCTime` t1) * 1000.0 :: Double



data Tree = Leaf Int | Node Tree Tree deriving (Generic)

someTreeOfDepth :: Int -> Tree
someTreeOfDepth 0 = Leaf 42
someTreeOfDepth 1 = Leaf 1337
someTreeOfDepth n = Node (someTreeOfDepth (n - 1)) (someTreeOfDepth (n - 2))
-- someTreeOfDepth n = Node subtree subtree where subtree = someTreeOfDepth (n - 1)

doubleTree :: Tree -> Tree
doubleTree (Leaf n)   = Leaf (n * 2)
doubleTree (Node l r) = Node (doubleTree l) (doubleTree r)


-- instance NFData Tree where rnf = genericRnf

instance NFData Tree where
  rnf (Leaf n)   = n `seq` ()
  rnf (Node l r) = rnf l `seq` rnf r


main :: IO ()
main = do

    l <- benchmarkForce "create list" $
        return [1..10000000 :: Integer]

    _ <- benchmarkForce "double each list element" $
        return $ map (*2) l

    _ <- benchmarkForce "map id l" $
        return $ map id l

    t <- benchmarkForce "create tree" $
        return $ someTreeOfDepth 30

    _ <- benchmarkForce "double each tree element" $
        return $ doubleTree t

    return ()