-- |
-- Module : GHC.Heap.NormalForm
-- Copyright : [2020] The Accelerate Team
-- License : BSD3
--
-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com>
-- Stability : experimental
-- Portability : non-portable (GHC extensions)
--
-- https://github.com/input-output-hk/cardano-prelude/blob/96e8dcb29dc3c29eee99c0d020152fad6071af6d/src/Cardano/Prelude/GHC/Heap/NormalForm.hs
--
-- This code has been adapted from the module "GHC.AssertNF" of the package
-- <http://hackage.haskell.org/package/ghc-heap-view ghc-heap-view>
-- (<https://github.com/nomeata/ghc-heap-view GitHub>) authored by
-- Joachim Breitner.
--
-- To avoid space leaks and unwanted evaluation behaviour, the programmer
-- might want his data to be fully evaluated at certain positions in the
-- code. This can be enforced, for example, by ample use of
-- "Control.DeepSeq", but this comes at a cost.
--
-- Experienced users hence use 'Control.DeepSeq.deepseq' only to find out
-- about the existence 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'.
--
module GHC.Heap.NormalForm (
isHeadNormalForm,
isNormalForm,
) where
import GHC.Exts.Heap
-- Everything is in normal form, unless it is a thunk explicitly marked as
-- such. Indirection are also considered to be in HNF.
--
isHeadNormalForm :: Closure -> IO Bool
isHeadNormalForm c = do
case c of
ThunkClosure{} -> return False
APClosure{} -> return False
SelectorClosure{} -> return False
BCOClosure{} -> return False
_ -> return True
-- | The function 'isNormalForm' checks whether its argument is fully evaluated
-- and deeply evaluated.
--
-- NOTE 1: If you want to override the behaviour of 'isNormalForm' for specific
-- types (in particular, for specific types that may be /nested/ somewhere
-- inside the @a@), consider using
-- 'Cardano.Prelude.GHC.Heap.NormalForm.Classy.noUnexpectedThunks' instead.
--
-- NOTE 2: The normal form check can be quite brittle, especially with @-O0@.
-- For example, writing something like
--
-- > let !(Value x) = ... in ....
--
-- might translate to
--
-- > let !.. = ... in ... (case ... of Value x -> x)
--
-- which would trivially be @False@. In general, 'isNormalForm' should probably
-- only be used with @-O1@, but even then the answer may still depend on
-- internal decisions made by ghc during compilation.
--
isNormalForm :: a -> IO Bool
isNormalForm x = isNormalFormBoxed (asBox x)
isNormalFormBoxed :: Box -> IO Bool
isNormalFormBoxed b = do
c <- getBoxedClosureData b
nf <- isHeadNormalForm c
if nf
then do
c' <- getBoxedClosureData b
allM isNormalFormBoxed (allClosures c')
else do
return False
-- From Control.Monad.Loops in monad-loops
--
allM :: Monad m => (a -> m Bool) -> [a] -> m Bool
allM _ [] = return True
allM p (x : xs) = do
q <- p x
if q
then allM p xs
else return False