src/GHC/AssertNF.hs

   1 {-# LANGUAGE BangPatterns, DoAndIfThenElse #-}
   2
   3 {-|
   4 Module      :  GHC.AssertNF
   5 Copyright   :  (c) 2013 Joachim Breitner
   6 License     :  BSD3
   7 Maintainer  :  Joachim Breitner <mail@joachim-breitner.de>
   8
   9 To avoid space leaks and unwanted evaluation behaviour, the programmer might want his data to be fully evaluated at certians positions in the code. This can be enforced, for example, by ample use of "Control.DeepSeq", but this comes at a cost.
  10
  11 Experienced users hence use 'Control.DeepSeq.deepseq' only to find out about the existance of space leaks and optimize their code to not create the thunks in the first place, until the code no longer shows better performance with 'deepseq'.
  12
  13 This module provides an alternative approach: An explicit assertion about the evaluation state. If the programmer expect a certain value to be fully evaluated at a specific point of the program (e.g. before a call to 'writeIORef'), he can state that, and as long as assertions are enabled, this statement will be checked. In the production code the assertions can be disabled, to avoid the run-time cost.
  14
  15 -}
  16
  17
  18 module GHC.AssertNF (
  19     assertNF,
  20     assertNFNamed,
  21     assertNFHere,
  22     disableAssertNF,
  23     )
  24 where
  25
  26 import GHC.HeapView
  27 import Debug.Trace
  28 import Control.Monad
  29 import Data.Functor
  30 import Text.Printf
  31 import Language.Haskell.TH (Q, Exp(AppE,VarE,LitE), Lit(StringL), Loc, location, loc_filename, loc_start, mkName)
  32 import Data.IORef
  33 import System.IO.Unsafe ( unsafePerformIO )
  34
  35 enabledRef :: IORef Bool
  36 enabledRef = unsafePerformIO $ newIORef True
  37 {-# NOINLINE enabledRef #-}
  38
  39 -- Everything is in normal form, unless it is a
  40 -- thunks explicitly marked as such.
  41 -- Indirection are also considered to be in HNF
  42 isHNF :: Closure -> IO Bool
  43 isHNF c = do
  44     case c of
  45         ThunkClosure {}    -> return False
  46         APClosure {}       -> return False
  47         SelectorClosure {} -> return False
  48         BCOClosure {}      -> return False
  49         _                  -> return True
  50
  51 -- | The function 'assertNF' checks whether its argument is fully evaluated and
  52 -- deeply evaluated. If this is not the case, a warning is printed to the standard output,
  53 -- giving the number of thunks found and printing the shape of the unevaluated object:
  54 --
  55 -- >> let x = 1 + 2
  56 -- >> let y = (x,x)
  57 -- >> assertNF y
  58 -- >Parameter not in normal form: 2 thunks found:
  59 -- >let t1 = _bco
  60 -- >in (t1,t1)
  61 -- >> x
  62 -- >3
  63 -- >> assertNF y
  64 -- >>
  65 --
  66 assertNF :: a -> IO ()
  67 assertNF = assertNF' "Parameter not in normal form"
  68
  69 -- | In order to better identify the source of error messages from 'assertNF', this variant allows you to include a name that is printed in the output:
  70 --
  71 -- >> assertNFNamed "y" y
  72 -- >y not in normal form: 2 thunks found:
  73 -- >let t1 = _bco
  74 -- >in (t1,t1)
  75 --
  76 assertNFNamed :: String -> a -> IO ()
  77 assertNFNamed valName = assertNF' (valName ++ " not in normal form")
  78
  79 -- | This function, when called as @$assertNFHere@ in a module with @-XTemplateHaskell@ enabled, will cause the current filename and position be included in the error message:
  80 --
  81 -- >Parameter at Test.hs:18:1 not in normal form: 2 thunks found:
  82 -- >let t1 = _bco
  83 -- >in (t1,t1)
  84 --
  85 assertNFHere :: Q Exp
  86 assertNFHere = do
  87     locStr <- formatLoc <$> location
  88     -- We don't use ''assertNF here, so that this module can be used on a
  89     -- compiler that does not support TH.
  90     return $ AppE (VarE (mkName "GHC.AssertNF.assertNFNamed"))
  91                   (LitE (StringL locStr))
  92   where formatLoc :: Loc -> String
  93         formatLoc loc = let file = loc_filename loc
  94                             (line, col) = loc_start loc
  95                         in  printf "parameter at %s:%d:%d" file line col
  96
  97 assertNF' :: String ->  a -> IO ()
  98 assertNF' str x = do
  99     en <- readIORef enabledRef
 100     when en $ do
 101         depths <- assertNFBoxed 0 (asBox x)
 102         unless (null depths) $ do
 103             g <- buildHeapGraph (maximum depths + 3) () (asBox x)
 104                 -- +3 for good mesure; applications don't look good otherwise
 105             traceIO $ str ++ ": " ++ show (length depths) ++ " thunks found:\n" ++
 106                 ppHeapGraph g
 107
 108
 109 assertNFBoxed :: Int -> Box -> IO [Int]
 110 assertNFBoxed !d b = do
 111     c <- getBoxedClosureData b
 112     nf <- isHNF c
 113     if nf
 114     then do
 115         c' <- getBoxedClosureData b
 116         concat <$> mapM (assertNFBoxed (d+1)) (allPtrs c')
 117     else do
 118         return [d]
 119
 120 -- | Invoke this function at the top of your 'main' method to turn every call
 121 -- to 'assertNF' and its variants to noops.
 122 disableAssertNF :: IO ()
 123 disableAssertNF = writeIORef enabledRef False