Initial check-in
[darcs-mirror-ghc-deepseq.git] / src / GHC / DeepSeq.hs
1 {-|
2 Module      :  GHC.DeepSeq
3 Copyright   :  (c) 2013 Joachim Breitner
4 License     :  BSD3
5 Maintainer  :  Joachim Breitner <mail@joachim-breitner.de>
6
7 A generic version of 'deepseq' that investigates the heap structure.
8 -}
9
10
11 module GHC.DeepSeq where
12
13 import GHC.HeapView
14 import Control.Monad
15 import System.IO.Unsafe
16
17 evalBox :: Box -> IO ()
18 evalBox (Box a) = a `seq` return ()
19
20 needsEval :: Closure -> IO Bool
21 needsEval c = do
22     case c of
23         ThunkClosure {}    -> return True 
24         APClosure {}       -> return True
25         IndClosure {}      -> getBoxedClosureData (indirectee c) >>= needsEval
26         SelectorClosure {} -> return True
27         _                  -> return False
28
29 isConstructor :: Closure -> Bool
30 isConstructor (ConsClosure {}) = True
31 isConstructor _ = False
32
33
34 deepEval :: Box -> IO ()
35 deepEval b = do
36     c <- getBoxedClosureData b
37     evalNeeded <- needsEval c
38     when evalNeeded $ evalBox b
39     when (isConstructor c) $ do
40         c' <- getBoxedClosureData b
41         mapM_ deepEval (allPtrs c')
42
43 deepseq :: a -> b -> b
44 deepseq v x = unsafePerformIO $ do
45     deepEval (asBox v)
46     return x
47